{ *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * * *************************************************************************** Author: Tom Gregorovic } unit FPDocFiles; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Contnrs, FileUtil, DOM, XMLWrite, XMLRead; type TFPDocInfo = record Packages: Integer; Modules: Integer; Topics: Integer; Elements: Integer; ElementsNonEmpty: Integer; Shorts: Integer; Descriptions: Integer; Errors: Integer; SeeAlsos: Integer; Examples: Integer; end; const EmptyFPDocInfo: TFPDocInfo = ( Packages: 0; Modules: 0; Topics: 0; Elements: 0; ElementsNonEmpty: 0; Shorts: 0; Descriptions: 0; Errors: 0; SeeAlsos: 0; Examples: 0; ); type TUniqueName = record Name: String; Indexes: Array of Integer; NonEmptyCount: Integer; end; TUniqueNameArray = Array of TUniqueName; TFPDocNode = class; { TFPDocItem } TFPDocItem = class private FParent: TFPDocItem; FModified: Boolean; public constructor Create(const AParent: TFPDocItem); function GetInfo: TFPDocInfo; virtual; abstract; procedure Modify; virtual; procedure Reset; virtual; function AddNode(const AName: String): TFPDocNode; virtual; abstract; function InsertNode(Index: Integer; const AName: String): TFPDocNode; virtual; abstract; procedure DeleteNode(ANode: TFPDocNode); virtual; abstract; procedure RenameNode(ANode: TFPDocNode; const AName: String); virtual; abstract; public property Modified: Boolean read FModified write FModified; property Parent: TFPDocItem read FParent; end; { TFPDocNode } TFPDocNodeClass = class of TFPDocNode; TFPDocNode = class(TFPDocItem) private FName: String; FDOMNode: TDOMNode; function GetDOMNodeValue(const AName: String): String; function GetDescription: String; function GetShort: String; procedure SetDOMNodeValue(const AName, AValue: String); procedure SetDescription(const AValue: String); procedure SetShort(const AValue: String); protected function InsertDOMNode(const AName: String; const ADOMNode: TDOMNode): TDOMNode; virtual; function GetEmpty: Boolean; virtual; public constructor Create(const AParent: TFPDocItem; const ADOMNode: TDOMNode); procedure Assign(ASource: TFPDocNode); function GetInfo: TFPDocInfo; override; procedure Rename(const S: String); procedure Delete; public property Name: String read FName; property Description: String read GetDescription write SetDescription; property Short: String read GetShort write SetShort; property Empty: Boolean read GetEmpty; end; { TFPDocElement } TFPDocElement = class(TFPDocNode) private FExamples: TList; function GetErrors: String; function GetExample(Index: Integer): String; function GetExamplesCount: Integer; function GetSeeAlso: String; procedure SetErrors(const AValue: String); procedure SetExample(Index: Integer; const AValue: String); procedure SetSeeAlso(const AValue: String); protected function GetEmpty: Boolean; override; public constructor Create(const AParent: TFPDocItem; const ADOMNode: TDOMNode); destructor Destroy; override; procedure Assign(ASource: TFPDocElement); function GetInfo: TFPDocInfo; override; procedure ParseExamples; virtual; function AddExample(const AFileName: String): Integer; virtual; function InsertExample(Index: Integer; const AFileName: String): Integer; virtual; procedure DeleteExample(Index: Integer); virtual; function AddNode(const AName: String): TFPDocNode; override; procedure DeleteNode(ANode: TFPDocNode); override; function InsertNode(Index: Integer; const AName: String): TFPDocNode; override; procedure RenameNode(ANode: TFPDocNode; const AName: String); override; public property Errors: String read GetErrors write SetErrors; property SeeAlso: String read GetSeeAlso write SetSeeAlso; property Examples[Index: Integer]: String read GetExample write SetExample; property ExamplesCount: Integer read GetExamplesCount; end; { TFPDocTopic } TFPDocTopic = class(TFPDocNode) private FTopics: TObjectList; function GetTopicsCount: Integer; function GetTopic(Index: Integer): TFPDocTopic; public constructor Create(const AParent: TFPDocItem; const ADOMNode: TDOMNode); destructor Destroy; override; procedure ParseTopics; virtual; procedure AddTopic(const ATopic: TFPDocTopic); procedure Assign(ASource: TFPDocTopic); function GetInfo: TFPDocInfo; override; procedure Reset; override; function AddTopic(const AName: String): TFPDocTopic; virtual; function InsertTopic(Index: Integer; const AName: String): TFPDocTopic; virtual; procedure DeleteNode(ANode: TFPDocNode); override; procedure RenameNode(ANode: TFPDocNode; const AName: String); override; public function AddNode(const AName: String): TFPDocNode; override; function InsertNode(Index: Integer; const AName: String): TFPDocNode; override; property Topics[Index: Integer]: TFPDocTopic read GetTopic; property TopicsCount: Integer read GetTopicsCount; end; { TFPDocNodeWithList } TFPDocNodeWithList = class(TFPDocTopic) private FNodes: TObjectList; FNames: TStringList; function GetCount: Integer; function GetNode(Index: Integer): TFPDocNode; function GetNodeByName(const Index: String): TFPDocNode; public constructor Create(const AParent: TFPDocItem; const ADOMNode: TDOMNode); destructor Destroy; override; procedure ParseNodes; virtual; abstract; procedure Reset; override; function GetUniqueNames: TUniqueNameArray; function AddNode(const AName: String): TFPDocNode; override; procedure DeleteNode(ANode: TFPDocNode); override; procedure RenameNode(ANode: TFPDocNode; const AName: String); override; public property Nodes[Index: Integer]: TFPDocNode read GetNode; property NodesByName[const Index: String]: TFPDocNode read GetNodeByName; property Count: Integer read GetCount; property Names: TStringList read FNames; end; { TFPDocModule } TFPDocModule = class(TFPDocNodeWithList) private function GetElement(Index: Integer): TFPDocElement; function GetElementByName(const Index: String): TFPDocElement; public function GetInfo: TFPDocInfo; override; procedure ParseNodes; override; function InsertNode(Index: Integer; const AName: String): TFPDocNode; override; public property Elements[Index: Integer]: TFPDocElement read GetElement; property ElementsByName[const Index: String]: TFPDocElement read GetElementByName; end; { TFPDocPackage } TFPDocPackage = class(TFPDocNodeWithList) private function GetModule(Index: Integer): TFPDocModule; function GetModuleByName(const Index: String): TFPDocModule; public function GetInfo: TFPDocInfo; override; procedure ParseNodes; override; function InsertNode(Index: Integer; const AName: String): TFPDocNode; override; public property Modules[Index: Integer]: TFPDocModule read GetModule; property ModulesByName[const Index: String]: TFPDocModule read GetModuleByName; end; TMoveElementEvent = procedure (const SrcPackage: TFPDocPackage; const SrcModule: TFPDocModule; const Src: TFPDocElement; const DestList: TStrings; var Dest: Integer) of object; { TFPDocFile } TFPDocFile = class(TFPDocNodeWithList) private FDocument: TXMLDocument; function GetPackage(Index: Integer): TFPDocPackage; function GetPackageByName(const Index: String): TFPDocPackage; public constructor Create(const FileName: String); constructor Create(Stream: TStream); destructor Destroy; override; procedure ParseNodes; override; procedure SaveToFile(const FileName: String); procedure AssignToSkeleton(const SkeletonFile: TFPDocFile; OnMoveElement: TMoveElementEvent); function GetInfo: TFPDocInfo; override; function InsertNode(Index: Integer; const AName: String): TFPDocNode; override; public property Packages[Index: Integer]: TFPDocPackage read GetPackage; property PackagesByName[const Index: String]: TFPDocPackage read GetPackageByName; end; const SFPDocHeader = 'fpdoc-descriptions'; SFPDocPackage = 'package'; SFPDocModule = 'module'; SFPDocTopic = 'topic'; SFPDocElement = 'element'; SFPDocName = 'name'; SFPDocFile = 'file'; SFPDocDescr = 'descr'; SFPDocShort = 'short'; SFPDocErrors = 'errors'; SFPDocSeeAlso = 'seealso'; SFPDocExample = 'example'; function DbgS(const AInfo: TFPDocInfo): String; overload; implementation uses LCLProc; function DbgS(const AInfo: TFPDocInfo): String; begin Result := SFPDocPackage + 's: ' + IntToStr(AInfo.Packages) + LineEnding + SFPDocModule + 's: ' + IntToStr(AInfo.Modules) + LineEnding + SFPDocTopic + 's: ' + IntToStr(AInfo.Topics) + LineEnding + SFPDocElement + 's: ' + IntToStr(AInfo.Elements) + LineEnding + SFPDocElement + 's NonEmpty: ' + IntToStr(AInfo.ElementsNonEmpty) + LineEnding + SFPDocShort + 's: ' + IntToStr(AInfo.Shorts) + LineEnding + SFPDocDescr + 's: ' + IntToStr(AInfo.Descriptions) + LineEnding + SFPDocErrors + 's: ' + IntToStr(AInfo.Errors) + LineEnding + SFPDocSeeAlso + 's: ' + IntToStr(AInfo.SeeAlsos) + LineEnding + SFPDocExample + 's: ' + IntToStr(AInfo.Examples); end; { TFPDocItem } constructor TFPDocItem.Create(const AParent: TFPDocItem); begin FParent := AParent; FModified := False; end; procedure TFPDocItem.Modify; begin FModified := True; if FParent <> nil then FParent.Modify; end; procedure TFPDocItem.Reset; begin FModified := False; end; { TFPDocNode } function TFPDocNode.GetDOMNodeValue(const AName: String): String; var N: TDOMNode; S: TStringStream; D: TDOMNode; begin Result := ''; N := FDOMNode.FindNode(AName); if N = nil then Exit; if N.FirstChild = nil then Exit; S := TStringStream.Create(''); try D := N.FirstChild; while D <> nil do begin WriteXML(D, S); D := D.NextSibling; end; Result := S.DataString; finally S.Free; end; end; function TFPDocNode.GetDescription: String; begin Result := GetDOMNodeValue(SFPDocDescr); end; function TFPDocNode.GetShort: String; begin Result := GetDOMNodeValue(SFPDocShort); end; procedure TFPDocNode.SetDOMNodeValue(const AName, AValue: String); var N: TDOMNode; S: TStream; begin //DebugLn(FName, ' ', AName); N := FDOMNode.FindNode(AName); if N = nil then begin if AValue = '' then Exit; N := FDOMNode.OwnerDocument.CreateElement(AName); N := InsertDOMNode(AName, N); //DebugLn('New'); end else while N.LastChild <> nil do N.RemoveChild(N.LastChild); if AValue = '' then Exit; S := TStringStream.Create(AValue); try ReadXMLFragment(N, S); finally S.Free; end; Modify; end; procedure TFPDocNode.SetDescription(const AValue: String); begin SetDOMNodeValue(SFPDocDescr, AValue); end; procedure TFPDocNode.SetShort(const AValue: String); begin SetDOMNodeValue(SFPDocShort, AValue); end; function TFPDocNode.InsertDOMNode(const AName: String; const ADOMNode: TDOMNode): TDOMNode; begin if not FDOMNode.HasChildNodes then Result := FDOMNode.AppendChild(ADOMNode) else begin if AName = SFPDocShort then Result := FDOMNode.InsertBefore(ADOMNode, FDOMNode.FirstChild); if AName = SFPDocDescr then begin Result := FDOMNode.FindNode(SFPDocShort); if Result = nil then Result := FDOMNode.InsertBefore(ADOMNode, FDOMNode.FirstChild) else Result := FDOMNode.InsertBefore(ADOMNode, Result.NextSibling); end else if AName = SFPDocErrors then begin Result := FDOMNode.FindNode(SFPDocDescr); if Result = nil then Result := FDOMNode.FindNode(SFPDocShort); if Result = nil then Result := FDOMNode.InsertBefore(ADOMNode, FDOMNode.FirstChild) else Result := FDOMNode.InsertBefore(ADOMNode, Result.NextSibling); end else if AName = SFPDocSeeAlso then begin Result := FDOMNode.FindNode(SFPDocErrors); if Result = nil then Result := FDOMNode.FindNode(SFPDocDescr); if Result = nil then Result := FDOMNode.FindNode(SFPDocShort); if Result = nil then Result := FDOMNode.InsertBefore(ADOMNode, FDOMNode.FirstChild) else Result := FDOMNode.InsertBefore(ADOMNode, Result.NextSibling); end; end; end; function TFPDocNode.GetEmpty: Boolean; begin Result := (Description = '') and (Short = ''); end; constructor TFPDocNode.Create(const AParent: TFPDocItem; const ADOMNode: TDOMNode); begin inherited Create(AParent); FDOMNode := ADOMNode; FName := (FDOMNode as TDOMElement).GetAttribute(SFPDocName); end; procedure TFPDocNode.Assign(ASource: TFPDocNode); begin Short := ASource.Short; Description := ASource.Description; end; function TFPDocNode.GetInfo: TFPDocInfo; begin Result.Packages := 0; Result.Modules := 0; Result.Topics := 0; Result.Elements := 0; Result.ElementsNonEmpty := 0; if Short <> '' then Result.Shorts := 1 else Result.Shorts := 0; if Description <> '' then Result.Descriptions := 1 else Result.Descriptions := 0; Result.Errors := 0; Result.SeeAlsos := 0; Result.Examples := 0; end; procedure TFPDocNode.Rename(const S: String); begin if S <> Name then Parent.RenameNode(Self, S); end; procedure TFPDocNode.Delete; begin Parent.DeleteNode(Self); end; { TFPDocElement } function TFPDocElement.GetEmpty: Boolean; begin Result := (Description = '') and (Short = '') and (Errors = '') and (SeeAlso = '') and (ExamplesCount = 0); end; function TFPDocElement.GetErrors: String; begin Result := GetDOMNodeValue(SFPDocErrors); end; function TFPDocElement.GetExample(Index: Integer): String; begin Result := TDOMElement(FExamples[Index]).GetAttribute(SFPDocFile); end; function TFPDocElement.GetExamplesCount: Integer; begin Result := FExamples.Count; end; function TFPDocElement.GetSeeAlso: String; begin Result := GetDOMNodeValue(SFPDocSeeAlso); end; procedure TFPDocElement.SetErrors(const AValue: String); begin SetDOMNodeValue(SFPDocErrors, AValue); end; procedure TFPDocElement.SetExample(Index: Integer; const AValue: String); begin TDOMElement(FExamples[Index]).SetAttribute(SFPDocFile, AValue); end; procedure TFPDocElement.SetSeeAlso(const AValue: String); begin SetDOMNodeValue(SFPDocSeeAlso, AValue); end; constructor TFPDocElement.Create(const AParent: TFPDocItem; const ADOMNode: TDOMNode); begin inherited; FExamples := TList.Create; ParseExamples; end; destructor TFPDocElement.Destroy; begin FExamples.Free; inherited Destroy; end; procedure TFPDocElement.Assign(ASource: TFPDocElement); var I: Integer; begin inherited Assign(ASource); Errors := ASource.Errors; SeeAlso := ASource.SeeAlso; FExamples.Clear; DebugLn('Assign Examples: ' + ASource.Name + ' ' + DbgS(ASource.ExamplesCount)); for I := 0 to ASource.ExamplesCount - 1 do AddExample(ASource.Examples[I]); end; function TFPDocElement.GetInfo: TFPDocInfo; begin Result := inherited GetInfo; Result.Elements := 1; if Empty then Result.ElementsNonEmpty := 0 else Result.ElementsNonEmpty := 1; if Errors <> '' then Result.Errors := 1 else Result.Errors := 0; if SeeAlso <> '' then Result.SeeAlsos := 1 else Result.SeeAlsos := 0; Result.Examples := ExamplesCount; end; procedure TFPDocElement.ParseExamples; var I: TDOMNode; begin FExamples.Clear; I := FDOMNode.FirstChild; while I <> nil do begin if I.NodeName = SFPDocExample then begin FExamples.Add(Pointer(I)); end; I := I.NextSibling; end; end; function TFPDocElement.AddExample(const AFileName: String): Integer; begin Result := InsertExample(ExamplesCount, AFileName); end; function TFPDocElement.InsertExample(Index: Integer; const AFileName: String): Integer; var E: TDOMElement; N: TDOMNode; begin if Index < 0 then Index := 0; if Index > ExamplesCount then Index := ExamplesCount; E := FDOMNode.OwnerDocument.CreateElement(SFPDocExample); E.SetAttribute(SFPDocFile, AFileName); if Index >= ExamplesCount then N := FDOMNode.AppendChild(E) else N := FDOMNode.InsertBefore(E, TDOMNode(FExamples[Index])); FExamples.Insert(Index, Pointer(N)); Result := Index; end; procedure TFPDocElement.DeleteExample(Index: Integer); begin FDOMNode.RemoveChild(TDOMNode(FExamples[Index])); FExamples.Delete(Index); end; function TFPDocElement.AddNode(const AName: String): TFPDocNode; begin raise Exception.Create(''); Result:=nil; end; procedure TFPDocElement.DeleteNode(ANode: TFPDocNode); begin raise Exception.Create(''); end; function TFPDocElement.InsertNode(Index: Integer; const AName: String ): TFPDocNode; begin raise Exception.Create(''); Result:=nil; end; procedure TFPDocElement.RenameNode(ANode: TFPDocNode; const AName: String); begin raise Exception.Create(''); end; { TFPDocTopic } function TFPDocTopic.GetTopicsCount: Integer; begin Result := FTopics.Count; end; function TFPDocTopic.GetTopic(Index: Integer): TFPDocTopic; begin Result := FTopics[Index] as TFPDocTopic; end; constructor TFPDocTopic.Create(const AParent: TFPDocItem; const ADOMNode: TDOMNode); begin inherited; FTopics := TObjectList.Create(True); //DebugLn(Name); ParseTopics; end; destructor TFPDocTopic.Destroy; begin FTopics.Free; inherited Destroy; end; procedure TFPDocTopic.ParseTopics; var I: TDOMNode; T: TFPDocTopic; begin FTopics.Clear; I := FDOMNode.FirstChild; while I <> nil do begin if I.NodeName = SFPDocTopic then begin T := TFPDocTopic.Create(Self, I); FTopics.Add(T); end; I := I.NextSibling; end; end; procedure TFPDocTopic.AddTopic(const ATopic: TFPDocTopic); begin AddTopic(ATopic.Name).Assign(ATopic); end; procedure TFPDocTopic.Assign(ASource: TFPDocTopic); var I: Integer; begin inherited; for I := 0 to ASource.TopicsCount - 1 do AddTopic(ASource.Topics[I]); end; function TFPDocTopic.GetInfo: TFPDocInfo; var I: Integer; Info: TFPDocInfo; begin Result := inherited GetInfo; if ClassType <> TFPDocTopic then Result.Topics := 0 else Result.Topics := 1; for I := 0 to TopicsCount - 1 do begin Info := Topics[I].GetInfo; Result.Topics := Result.Topics + Info.Topics; Result.Shorts := Result.Shorts + Info.Shorts; Result.Descriptions := Result.Descriptions + Info.Descriptions; end; end; procedure TFPDocTopic.Reset; var I: Integer; begin inherited; for I := 0 to TopicsCount - 1 do Topics[I].Reset; end; function TFPDocTopic.AddTopic(const AName: String): TFPDocTopic; begin Result := InsertTopic(TopicsCount, AName); end; function TFPDocTopic.InsertTopic(Index: Integer; const AName: String): TFPDocTopic; var N: TDOMElement; begin N := FDOMNode.OwnerDocument.CreateElement(SFPDocTopic); N.AttribStrings[SFPDocName] := AName; if Index < 0 then Index := 0; if Index > TopicsCount then Index := TopicsCount; if Index < TopicsCount then Result := TFPDocTopic.Create(Self, FDOMNode.InsertBefore(N, Topics[Index].FDOMNode)) else Result := TFPDocTopic.Create(Self, FDOMNode.AppendChild(N)); FTopics.Insert(Index, Result); Result.Modify; end; procedure TFPDocTopic.DeleteNode(ANode: TFPDocNode); begin FDOMNode.RemoveChild(ANode.FDOMNode); FTopics.Remove(ANode); Modify; end; procedure TFPDocTopic.RenameNode(ANode: TFPDocNode; const AName: String); begin (ANode.FDOMNode as TDOMElement).SetAttribute(SFPDocName, AName); ANode.FName := AName; ANode.Modify; end; function TFPDocTopic.AddNode(const AName: String): TFPDocNode; begin raise Exception.Create(''); Result:=nil; end; function TFPDocTopic.InsertNode(Index: Integer; const AName: String ): TFPDocNode; begin raise Exception.Create(''); Result:=nil; end; { TFPDocNodeWithList } function TFPDocNodeWithList.GetCount: Integer; begin Result := FNodes.Count; end; function TFPDocNodeWithList.GetNode(Index: Integer): TFPDocNode; begin Result := FNodes[Index] as TFPDocNode; end; function TFPDocNodeWithList.GetNodeByName(const Index: String): TFPDocNode; var I: Integer; begin I := FNames.IndexOf(Index); if I = -1 then Result := nil else Result := FNames.Objects[I] as TFPDocNode; end; constructor TFPDocNodeWithList.Create(const AParent: TFPDocItem; const ADOMNode: TDOMNode); begin inherited; FNodes := TObjectList.Create(True); FNames := TStringList.Create; FNames.Sorted := True; ParseNodes; end; destructor TFPDocNodeWithList.Destroy; begin FNames.Free; FNodes.Free; inherited Destroy; end; procedure TFPDocNodeWithList.Reset; var I: Integer; begin inherited; for I := 0 to Count - 1 do Nodes[I].Reset; end; function TFPDocNodeWithList.GetUniqueNames: TUniqueNameArray; var I, J: Integer; Found: Boolean; begin SetLength(Result, 0); for I := 0 to Count - 1 do begin Found := False; for J := 0 to High(Result) do begin if Result[J].Name = Nodes[I].Name then begin Found := True; SetLength(Result[J].Indexes, Length(Result[J].Indexes) + 1); Result[J].Indexes[High(Result[J].Indexes)] := I; if not Nodes[I].Empty then Inc(Result[High(Result)].NonEmptyCount); Break; end; end; if not Found then begin SetLength(Result, Length(Result) + 1); Result[High(Result)].Name := Nodes[I].Name; SetLength(Result[High(Result)].Indexes, 1); Result[High(Result)].Indexes[0] := I; if Nodes[I].Empty then Result[High(Result)].NonEmptyCount := 0 else Result[High(Result)].NonEmptyCount := 1; end; end; end; function TFPDocNodeWithList.AddNode(const AName: String): TFPDocNode; begin Result := InsertNode(Count, AName); end; procedure TFPDocNodeWithList.DeleteNode(ANode: TFPDocNode); begin if ANode is TFPDocTopic then inherited else begin FDOMNode.RemoveChild(ANode.FDOMNode); FNames.Delete(FNames.IndexOfObject(ANode)); FNodes.Remove(ANode); Modify; end; end; procedure TFPDocNodeWithList.RenameNode(ANode: TFPDocNode; const AName: String); begin if not (ANode is TFPDocTopic) then FNames.Strings[FNames.IndexOfObject(ANode)] := AName; inherited; end; { TFPDocModule } function TFPDocModule.GetElement(Index: Integer): TFPDocElement; begin Result := FNodes[Index] as TFPDocElement; end; function TFPDocModule.GetElementByName(const Index: String): TFPDocElement; var I: Integer; begin I := FNames.IndexOf(Index); if I = -1 then Result := nil else Result := FNames.Objects[I] as TFPDocElement; end; function TFPDocModule.GetInfo: TFPDocInfo; var I: Integer; Info: TFPDocInfo; begin Result := inherited GetInfo; Result.Modules := 1; for I := 0 to Count - 1 do begin Info := Elements[I].GetInfo; Result.Elements := Result.Elements + Info.Elements; Result.ElementsNonEmpty := Result.ElementsNonEmpty + Info.ElementsNonEmpty; Result.Shorts := Result.Shorts + Info.Shorts; Result.Descriptions := Result.Descriptions + Info.Descriptions; Result.Errors := Result.Errors + Info.Errors; Result.SeeAlsos := Result.SeeAlsos + Info.SeeAlsos; Result.Examples := Result.Examples + Info.Examples; end; end; procedure TFPDocModule.ParseNodes; var I: TDOMNode; N: TFPDocElement; begin FNodes.Clear; FNames.Clear; I := FDOMNode.FirstChild; while I <> nil do begin if I.NodeName = SFPDocElement then begin N := TFPDocElement.Create(Self, I); FNodes.Add(N); FNames.AddObject(N.Name, N); end; I := I.NextSibling; end; end; function TFPDocModule.InsertNode(Index: Integer; const AName: String): TFPDocNode; var N: TDOMElement; begin N := FDOMNode.OwnerDocument.CreateElement(SFPDocElement); N.AttribStrings[SFPDocName] := AName; if Index < 0 then Index := 0; if Index > Count then Index := Count; if Index < Count then Result := TFPDocElement.Create(Self, FDOMNode.InsertBefore(N, Elements[Index].FDOMNode)) else if TopicsCount = 0 then Result := TFPDocElement.Create(Self, FDOMNode.AppendChild(N)) else Result := TFPDocElement.Create(Self, FDOMNode.InsertBefore(N, Topics[0].FDOMNode)); FNodes.Insert(Index, Result); FNames.AddObject(AName, Result); Result.Modify; end; { TFPDocPackage } function TFPDocPackage.GetModule(Index: Integer): TFPDocModule; begin Result := FNodes[Index] as TFPDocModule; end; function TFPDocPackage.GetModuleByName(const Index: String): TFPDocModule; var I: Integer; begin I := FNames.IndexOf(Index); if I = -1 then Result := nil else Result := FNames.Objects[I] as TFPDocModule; end; function TFPDocPackage.GetInfo: TFPDocInfo; var I: Integer; Info: TFPDocInfo; begin Result := inherited GetInfo; Result.Packages := 1; for I := 0 to Count - 1 do begin Info := Modules[I].GetInfo; Result.Modules := Result.Modules + Info.Modules; Result.Elements := Result.Elements + Info.Elements; Result.ElementsNonEmpty := Result.ElementsNonEmpty + Info.ElementsNonEmpty; Result.Shorts := Result.Shorts + Info.Shorts; Result.Descriptions := Result.Descriptions + Info.Descriptions; Result.Errors := Result.Errors + Info.Errors; Result.SeeAlsos := Result.SeeAlsos + Info.SeeAlsos; Result.Examples := Result.Examples + Info.Examples; end; end; procedure TFPDocPackage.ParseNodes; var I: TDOMNode; N: TFPDocModule; begin FNodes.Clear; FNames.Clear; I := FDOMNode.FirstChild; while I <> nil do begin if I.NodeName = SFPDocModule then begin N := TFPDocModule.Create(Self, I); FNodes.Add(N); FNames.AddObject(N.Name, N); end; I := I.NextSibling; end; end; function TFPDocPackage.InsertNode(Index: Integer; const AName: String ): TFPDocNode; var N: TDOMElement; begin N := FDOMNode.OwnerDocument.CreateElement(SFPDocModule); N.AttribStrings[SFPDocName] := AName; if Index < 0 then Index := 0; if Index > Count then Index := Count; if Index < Count then Result := TFPDocModule.Create(Self, FDOMNode.InsertBefore(N, Modules[Index].FDOMNode)) else if TopicsCount = 0 then Result := TFPDocModule.Create(Self, FDOMNode.AppendChild(N)) else Result := TFPDocModule.Create(Self, FDOMNode.InsertBefore(N, Topics[0].FDOMNode)); FNodes.Insert(Index, Result); FNames.AddObject(AName, Result); Result.Modify; end; { TFPDocFile } function TFPDocFile.GetPackage(Index: Integer): TFPDocPackage; begin Result := Nodes[Index] as TFPDocPackage; end; function TFPDocFile.GetPackageByName(const Index: String): TFPDocPackage; begin Result := NodesByName[Index] as TFPDocPackage; end; constructor TFPDocFile.Create(const FileName: String); var F: TFileStream; begin F := TFileStream.Create(UTF8ToSys(FileName), fmOpenRead); try Create(F); finally F.Free; end; end; constructor TFPDocFile.Create(Stream: TStream); var R: TDOMNode; begin ReadXMLFile(FDocument, Stream); R := FDocument.FindNode(SFPDocHeader); if R = nil then raise Exception.Create('Invalid FPDoc file!'); inherited Create(nil, R); end; destructor TFPDocFile.Destroy; begin FDocument.Free; inherited Destroy; end; procedure TFPDocFile.ParseNodes; var I: TDOMNode; P: TFPDocPackage; begin FNodes.Clear; FNames.Clear; I := FDOMNode.FirstChild; while I <> nil do begin if I.NodeName = SFPDocPackage then begin P := TFPDocPackage.Create(Self, I); FNodes.Add(P); FNames.AddObject(P.Name, P); end; I := I.NextSibling; end; end; procedure TFPDocFile.SaveToFile(const FileName: String); begin WriteXMLFile(FDocument, FileName); Reset; end; procedure TFPDocFile.AssignToSkeleton(const SkeletonFile: TFPDocFile; OnMoveElement: TMoveElementEvent); var I, J, K, L, M: Integer; P1, P2: TFPDocPackage; M1, M2: TFPDocModule; E1, E2: TFPDocElement; Elements1, Elements2: TUniqueNameArray; DestList: TStringList; procedure AskMove; var N: Integer; begin N := M; OnMoveElement(P1, M1, E1, DestList, N); if N <> -1 then begin M2.Elements[N].Assign(E1); if not M2.Elements[N].Empty then DestList.Objects[N] := TObject(1); end; end; begin for I := 0 to Count - 1 do begin P1 := Packages[I]; P2 := SkeletonFile.PackagesByName[P1.Name]; P2.Assign(P1); for J := 0 to P1.Count - 1 do begin M1 := P1.Modules[J]; M2 := P2.ModulesByName[M1.Name]; M2.Assign(M1); DestList := TStringList.Create; try for K := 0 to M2.Count - 1 do begin E2 := M2.Elements[K]; DestList.Add(E2.Name); end; Elements1 := M1.GetUniqueNames; Elements2 := M2.GetUniqueNames; for K := 0 to High(Elements1) do begin if Elements1[K].NonEmptyCount = 0 then Continue; M := -1; for L := 0 to High(Elements2) do begin if Elements1[K].Name = Elements2[L].Name then begin M := L; end; end; for L := 0 to High(Elements1[K].Indexes) do begin E1 := M1.Elements[Elements1[K].Indexes[L]]; if E1.Empty then Continue; if M = -1 then AskMove else if L > High(Elements2[M].Indexes) then AskMove else begin E2 := M2.Elements[Elements2[M].Indexes[L]]; if not E2.Empty then AskMove else begin E2.Assign(E1); if not E2.Empty then DestList.Objects[Elements2[M].Indexes[L]] := TObject(1); end; end; end; end; finally DestList.Free; end; end; end; end; function TFPDocFile.GetInfo: TFPDocInfo; var I: Integer; Info: TFPDocInfo; begin Result := EmptyFPDocInfo; for I := 0 to Count - 1 do begin Info := Packages[I].GetInfo; Result.Packages := Result.Packages + Info.Packages; Result.Modules := Result.Modules + Info.Modules; Result.Elements := Result.Elements + Info.Elements; Result.ElementsNonEmpty := Result.ElementsNonEmpty + Info.ElementsNonEmpty; Result.Shorts := Result.Shorts + Info.Shorts; Result.Descriptions := Result.Descriptions + Info.Descriptions; Result.Errors := Result.Errors + Info.Errors; Result.SeeAlsos := Result.SeeAlsos + Info.SeeAlsos; Result.Examples := Result.Examples + Info.Examples; end; end; function TFPDocFile.InsertNode(Index: Integer; const AName: String): TFPDocNode; var N: TDOMElement; begin N := FDocument.CreateElement(SFPDocPackage); N.AttribStrings[SFPDocName] := AName; if Index < 0 then Index := 0; if Index > Count then Index := Count; if Index < Count then Result := TFPDocPackage.Create(Self, FDocument.InsertBefore(N, Packages[Index].FDOMNode)) else Result := TFPDocPackage.Create(Self, FDocument.AppendChild(N)); FNodes.Insert(Index, Result); FNames.AddObject(AName, Result); Result.Modify; end; end.