codetools: implemented TCodeBufXMLConfig

git-svn-id: trunk@24500 -

components/codetools/codetoolmanager.pas

@@ -809,6 +809,8 @@ begin
   DefineTree.OnReadValue:=@OnDefineTreeReadValue;
   DefinePool:=TDefinePool.Create;
   SourceCache:=TCodeCache.Create;
+  if DefaultConfigCodeCache=nil then
+    DefaultConfigCodeCache:=SourceCache;
   SourceChangeCache:=TSourceChangeCache.Create;
   SourceChangeCache.OnBeforeApplyChanges:=@BeforeApplyingChanges;
   SourceChangeCache.OnAfterApplyChanges:=@AfterApplyingChanges;
@@ -870,6 +872,8 @@ begin
   {$IFDEF CTDEBUG}
   DebugLn('[TCodeToolManager.Destroy] E');
   {$ENDIF}
+  if DefaultConfigCodeCache=SourceCache then
+    DefaultConfigCodeCache:=nil;
   FreeAndNil(SourceCache);
   FreeAndNil(DirectoryCachePool);
   {$IFDEF CTDEBUG}

components/codetools/codetoolsconfig.pas

@@ -47,7 +47,34 @@ unit CodeToolsConfig;
 interface
 
 uses
-  Classes, SysUtils, Laz_XMLCfg, FileProcs, DefineTemplates;
+  Classes, SysUtils, Laz_XMLCfg, Laz_XMLRead, Laz_XMLWrite, Laz_DOM, FileProcs,
+  CodeCache, DefineTemplates;
+  
+type
+
+  { TCodeBufXMLConfig }
+
+  TCodeBufXMLConfig = class(TXMLConfig)
+  private
+    FCodeCache: TCodeCache;
+  protected
+    fKeepFileAttributes: boolean;
+    procedure ReadXMLFile(out ADoc: TXMLDocument; const AFilename: String
+            ); override;
+    procedure WriteXMLFile(ADoc: TXMLDocument; const AFileName: String);
+           override;
+    function GetCache: TCodeCache;
+  public
+    constructor CreateWithCache(AFilename: string;
+      LoadContent: boolean = true;        // init/load from disk
+      LoadFileAttributes: boolean = true; // load lineending and encoding
+      ASource: string = '';               // init with this source
+      ACache: TCodeCache = nil);
+    property CodeCache: TCodeCache read FCodeCache write FCodeCache;
+  end;
+
+var
+  DefaultConfigCodeCache: TCodeCache = nil; // set by CodeToolBoss
 
 type
 
@@ -354,5 +381,85 @@ begin
   end;
 end;
 
+{ TCodeBufXMLConfig }
+
+procedure TCodeBufXMLConfig.ReadXMLFile(out ADoc: TXMLDocument;
+  const AFilename: String);
+var
+  Buf: TCodeBuffer;
+  ms: TMemoryStream;
+  Cache: TCodeCache;
+begin
+  Cache:=GetCache;
+  if Cache<>nil then begin
+    Buf:=Cache.LoadFile(AFilename);
+    if Buf<>nil then begin
+      fKeepFileAttributes:=true;
+      ms:=TMemoryStream.Create;
+      try
+        Buf.SaveToStream(ms);
+        ms.Position:=0;
+        Laz_XMLRead.ReadXMLFile(ADoc, ms);
+      finally
+        ms.Free;
+      end;
+    end;
+  end;
+  // try default (this will create the normal exceptions)
+  inherited ReadXMLFile(ADoc, AFilename);
+end;
+
+procedure TCodeBufXMLConfig.WriteXMLFile(ADoc: TXMLDocument;
+  const AFileName: String);
+var
+  Buf: TCodeBuffer;
+  ms: TMemoryStream;
+  Cache: TCodeCache;
+begin
+  Cache:=GetCache;
+  if Cache<>nil then begin
+    Buf:=nil;
+    if (not fKeepFileAttributes) or (not FileExistsCached(AFileName)) then
+      Buf:=Cache.CreateFile(AFilename)
+    else
+      Buf:=Cache.LoadFile(AFilename);
+    if Buf<>nil then begin
+      fKeepFileAttributes:=true;
+      ms:=TMemoryStream.Create;
+      try
+        Laz_XMLWrite.WriteXMLFile(ADoc, ms);
+        ms.Position:=0;
+        Buf.LoadFromStream(ms);
+        if Buf.Save then exit;
+      finally
+        ms.Free;
+      end;
+    end;
+  end;
+  // try default (this will create the normal exceptions)
+  inherited WriteXMLFile(ADoc, AFileName);
+end;
+
+function TCodeBufXMLConfig.GetCache: TCodeCache;
+begin
+  Result:=CodeCache;
+  if Result=nil then
+    Result:=DefaultConfigCodeCache;
+end;
+
+constructor TCodeBufXMLConfig.CreateWithCache(AFilename: string;
+  LoadContent: boolean; LoadFileAttributes: boolean; ASource: string;
+  ACache: TCodeCache);
+begin
+  CodeCache:=ACache;
+  fKeepFileAttributes:=LoadFileAttributes;
+  if (ASource<>'') then
+    inherited CreateWithSource(AFilename,ASource)
+  else if LoadContent then
+    inherited Create(AFilename)
+  else
+    inherited CreateClean(AFilename);
+end;
+
 end.
 

components/codetools/laz_xmlcfg.pas

@@ -59,10 +59,13 @@ type
     procedure Loaded; override;
     function ExtendedToStr(const e: extended): string;
     function StrToExtended(const s: string; const ADefault: extended): extended;
+    procedure ReadXMLFile(out ADoc: TXMLDocument; const AFilename: String); virtual;
+    procedure WriteXMLFile(ADoc: TXMLDocument; const AFileName: String); virtual;
+    procedure FreeDoc; virtual;
   public
-    constructor Create(const AFilename: String); overload;
+    constructor Create(const AFilename: String); overload; // create and load
-    constructor CreateClean(const AFilename: String);
+    constructor CreateClean(const AFilename: String); // create new
-    constructor CreateWithSource(const AFilename, Source: String);
+    constructor CreateWithSource(const AFilename, Source: String); // create new and load from Source
     destructor Destroy; override;
     procedure Clear;
     procedure Flush;    // Writes the XML file
@@ -131,7 +134,7 @@ begin
   if Assigned(doc) then
   begin
     Flush;
-    doc.Free;
+    FreeDoc;
   end;
   inherited Destroy;
 end;
@@ -141,7 +144,7 @@ var
   cfg: TDOMElement;
 begin
   // free old document
-  doc.Free;
+  FreeDoc;
   // create new document
   doc := TXMLDocument.Create;
   cfg :=TDOMElement(doc.FindNode('CONFIG'));
@@ -163,15 +166,15 @@ end;
 
 procedure TXMLConfig.ReadFromStream(s: TStream);
 begin
-  FreeAndNil(Doc);
+  FreeDoc;
-  ReadXMLFile(Doc,s);
+  Laz_XMLRead.ReadXMLFile(Doc,s);
   if Doc=nil then
     Clear;
 end;
 
 procedure TXMLConfig.WriteToStream(s: TStream);
 begin
-  WriteXMLFile(Doc,s);
+  Laz_XMLWrite.WriteXMLFile(Doc,s);
 end;
 
 function TXMLConfig.GetValue(const APath, ADefault: String): String;
@@ -439,6 +442,22 @@ begin
   ThousandSeparator:=OldThousandSeparator;
 end;
 
+procedure TXMLConfig.ReadXMLFile(out ADoc: TXMLDocument; const AFilename: String
+  );
+begin
+  Laz_XMLRead.ReadXMLFile(ADoc,AFilename);
+end;
+
+procedure TXMLConfig.WriteXMLFile(ADoc: TXMLDocument; const AFileName: String);
+begin
+  Laz_XMLWrite.WriteXMLFile(ADoc,AFileName);
+end;
+
+procedure TXMLConfig.FreeDoc;
+begin
+  FreeAndNil(doc);
+end;
+
 procedure TXMLConfig.SetFilename(const AFilename: String);
 var
   cfg: TDOMElement;
@@ -454,18 +473,18 @@ begin
   if Assigned(doc) then
   begin
     Flush;
-    doc.Free;
+    FreeDoc;
   end;
 
   doc:=nil;
-  if (not fDoNotLoadFromFile) and FileExistsUTF8(AFilename) then
+  if (not fDoNotLoadFromFile) and FileExistsCached(AFilename) then
     ReadXMLFile(doc,AFilename)
   else if fAutoLoadFromSource<>'' then begin
     ms:=TMemoryStream.Create;
     try
       ms.Write(fAutoLoadFromSource[1],length(fAutoLoadFromSource));
       ms.Position:=0;
-      ReadXMLFile(doc,ms);
+      Laz_XMLRead.ReadXMLFile(doc,ms);
     finally
       ms.Free;
     end;

components/codetools/sourcelog.pas

@@ -173,7 +173,7 @@ type
     property WriteLock: integer read FWriteLock;
     procedure IncWriteLock;
     procedure DecWriteLock;
-    procedure Clear;  virtual;
+    procedure Clear; virtual; // clear content, not Encoding, not LineEnding
     function ConsistencyCheck: integer;
     function CalcMemSize: PtrUInt; virtual;
     constructor Create(const ASource: string);