瀏覽代碼

*** empty log message ***

Jean-Francois Goulet 19 年之前
父節點
當前提交
d6a7f2b7c6

+ 388 - 0
LuaEdit/LuaCore/Common/CopyRoutines.pas

@@ -0,0 +1,388 @@
+//******************************************************************************
+//***                   COMMON DELPHI FUNCTIONS                              ***
+//***                                                                        ***
+//***        (c) Massimo Magnano 2004-2005                                   ***
+//***                                                                        ***
+//***                                                                        ***
+//******************************************************************************
+//  File        : CopyRoutines.pas
+//
+//  Description : functions for copy e delete Dirs
+//
+//******************************************************************************
+
+unit CopyRoutines;
+
+interface
+uses Windows, SysUtils, Masks, Controls, FileVer, Dialogs;
+
+const
+    faOnlyFile  =$27;
+    faAnyDir    =$1F;
+
+    EXISTING_DONTCOPY        =0;
+    EXISTING_IF_VER_GREATER  =1;     //Copy if New File have greater version
+    EXISTING_IF_ASK          =2;
+    EXISTING_OVERWRITE       =3;
+
+type
+    TCopyPathProgressRoutine =procedure (Data :Pointer;
+                                         totalfiles,
+                                         currentfile :Integer;
+                                         FileName    :String;
+                                         TotalFileSize,
+                                         TotalBytesTransferred :LARGE_INTEGER;
+                                         var cancelled :Boolean
+                                         );
+
+  TCopyProgressRoutine = function (
+    TotalFileSize,	                        // total file size, in bytes
+    TotalBytesTransferred,	                // total number of bytes transferred
+    StreamSize,	                                // total number of bytes for this stream
+    StreamBytesTransferred : LARGE_INTEGER;     // total number of bytes transferred for this stream
+    dwStreamNumber,	                        // the current stream
+    dwCallbackReason :DWord;	                // reason for callback
+    hSourceFile,                         	// handle to the source file
+    hDestinationFile :THandle;	                // handle to the destination file
+    lpData :Pointer	                        // passed by CopyFileEx
+   ) :DWord; stdcall;
+
+
+procedure CopyPath(SourcePath, DestPath, wild :String;
+                   OnExistingFile :Integer; Recursive :Boolean =True;
+                   Data :Pointer=Nil; CopyProgressRoutine :TCopyPathProgressRoutine=Nil);
+procedure CopyFile(SourceFile, DestPath:String; OnExistingFile :Integer; DestFileName :String='';
+                   Data :Pointer=Nil; CopyProgressRoutine :TCopyPathProgressRoutine=Nil);
+
+
+procedure DeleteDir(BaseDir:String; SelName :String; Recursive, RemoveDirs :Boolean);
+
+function  AdjustPath(Path :String) :String;
+
+implementation
+
+type
+    TCopyPathData =record
+                    Data :Pointer;
+                    FileName :String;
+                    CopyProgressRoutine :TCopyPathProgressRoutine;
+                    totalfiles,
+                    currentfile   :Integer;
+                    cancelled     :Boolean;
+                    Check_Ask     :TModalResult;
+                  end;
+
+
+
+function internalProgress(
+    TotalFileSize,	                        // total file size, in bytes
+    TotalBytesTransferred,	                // total number of bytes transferred
+    StreamSize,	                                // total number of bytes for this stream
+    StreamBytesTransferred : LARGE_INTEGER;	// total number of bytes transferred for this stream
+    dwStreamNumber,	                        // the current stream
+    dwCallbackReason :DWord;	                // reason for callback
+    hSourceFile,                         	// handle to the source file
+    hDestinationFile :THandle;	                // handle to the destination file
+    lpData :Pointer	                        // passed by CopyFileEx
+   ) :DWord; stdcall;
+var
+   copyData :^TCopyPathData;
+
+begin
+     Result :=PROGRESS_CONTINUE;
+     copyData :=lpData;
+     if (copyData=Nil)
+     then Exit;
+
+     if assigned(copyData^.CopyProgressRoutine) then
+     begin
+          copyData^.CopyProgressRoutine(copyData^.Data,
+                                        copyData^.totalfiles,
+                                        copyData^.currentfile,
+                                        copyData^.FileName,
+                                        TotalFileSize, TotalBytesTransferred,
+                                        copyData^.cancelled);
+          if (copyData^.cancelled)
+          then Result :=PROGRESS_CANCEL;
+      end;
+end;
+
+function CheckExisting(SourceFileName, DestFileName :String;
+                       OnExistingFile :Integer; var AskResult :TModalResult) :Boolean;
+Var
+   SVer,
+   DVer,
+   SLang,
+   DLang,
+   SInfo,
+   DInfo   :String;
+   FInfo   :TSearchRec;
+
+   function Ask(MsgSource, MsgDest :String) :TModalResult;
+   begin
+        Result :=MessageDlg('Overwrite EXISTING File :'+#13#10#13#10+
+                            DestFileName+#13#10+MsgDest+#13#10#13#10+
+                            'With NEW File :'+#13#10#13#10+
+                            SourceFileName+#13#10+MsgSource+#13#10#13#10,
+                            mtConfirmation, mbYesAllNoAllCancel, 0);
+   end;
+
+begin
+     if FileExists(DestFileName)
+     then begin
+               Result :=True;
+               Case OnExistingFile of
+               EXISTING_DONTCOPY        : Result :=False;
+               EXISTING_IF_VER_GREATER  : begin
+                                               SVer :=GetFileVerLang(SourceFileName, SLang);
+                                               DVer :=GetFileVerLang(DestFileName, DLang);
+                                               Result := (CompareVer(SVer, DVer)>=0);
+                                          end;
+               EXISTING_IF_ASK          : begin
+                                               if AskResult=mrYesToAll
+                                               then begin
+                                                         Result :=True;
+                                                         Exit;
+                                                    end
+                                               else
+                                               if AskResult=mrNoToAll
+                                               then begin
+                                                         Result :=False;
+                                                         Exit;
+                                                    end;
+
+                                               SVer :=GetFileVerLang(SourceFileName, SLang);
+                                               DVer :=GetFileVerLang(DestFileName, DLang);
+
+                                               FindFirst(SourceFilename, faAnyFile,
+                                                         FInfo);
+                                               SInfo :=' Version '+SVer+' Lang '+SLang+#13#10+
+                                                  ' Date '+DateTimeToStr(FileDateToDateTime(FInfo.Time))+#13#10+
+                                                  ' Size '+IntToStr(FInfo.Size)+#13#10;
+                                               FindClose(FInfo);
+                                               FindFirst(DestFilename, faAnyFile,
+                                                         FInfo);
+                                               DInfo :=' Version '+DVer+' Lang '+DLang+#13#10+
+                                                  ' Date '+DateTimeToStr(FileDateToDateTime(FInfo.Time))+#13#10+
+                                                  ' Size '+IntToStr(FInfo.Size)+#13#10;
+                                               FindClose(FInfo);
+                                               AskResult :=Ask(SInfo, DInfo);
+                                               Result := (AskResult in [mrYes, mrYesToAll]);
+                                          end;
+               EXISTING_OVERWRITE        : Result :=True;
+               end;
+          end
+     else Result :=True;
+end;
+
+procedure CopyPath(SourcePath, DestPath, wild :String;
+                   OnExistingFile :Integer; Recursive :Boolean =True;
+                   Data :Pointer=Nil; CopyProgressRoutine :TCopyPathProgressRoutine=Nil);
+var
+   xSourcePath,
+   xDestPath     :String;
+   myData        :TCopyPathData;
+   int0          :LARGE_INTEGER;
+   CanCopy       :Boolean;
+
+
+   procedure copyDir(rSource, rDest, wild :String);
+   Var
+      fileInfo :TSearchRec;
+      Error :Integer;
+
+   begin
+        ForceDirectories(rDest);
+        //find first non entra nelle sotto dir se non è *.*
+        // non posso fare (*.*, faDirectory) perchè mi prende anche i file
+        // Questa si che è un mostro di API...
+        Error := FindFirst(rSource+'*.*', faAnyFile, FileInfo); //+wild
+
+        While (Error=0) Do
+        begin
+          if (FileInfo.Name[1] <> '.') then //non è [.] o [..]
+          begin
+               if ((FileInfo.Attr and faDirectory) = faDirectory)
+               then begin
+                         if Recursive
+                         then copyDir(rSource+FileInfo.Name+'\',
+                                      rDest+FileInfo.Name+'\', wild);
+                    end
+               else if MatchesMask(FileInfo.Name, wild) then
+                    begin
+                         myData.FileName :=rSource+FileInfo.Name;
+                         inc(myData.currentfile);
+
+                         CanCopy :=CheckExisting(myData.FileName, rDest+FileInfo.Name,
+                                                 OnExistingFile, myData.Check_Ask);
+                         myData.cancelled := myData.cancelled or
+                                             (myData.Check_Ask = mrCancel);
+
+                         if CanCopy
+                         then CopyFileEx(PChar(myData.FileName),
+                                         PChar(rDest+FileInfo.Name),
+                                         @internalProgress, @myData, Nil,
+                                         COPY_FILE_RESTARTABLE);
+                    end;
+
+           end;
+          Error :=FindNext(FileInfo);
+        end;
+        FindClose(FileInfo);
+    end;
+
+   procedure countDir(rSource, rDest, wild :String);
+   Var
+      fileInfo :TSearchRec;
+      Error :Integer;
+
+   begin
+        Error := FindFirst(rSource+'*.*', faAnyFile, FileInfo);
+        While (Error=0) Do
+        begin
+          if (FileInfo.Name[1] <> '.') then //non è [.] o [..]
+          begin
+               if ((FileInfo.Attr and faDirectory) = faDirectory)
+               then begin
+                         if Recursive
+                         then countDir(rSource+FileInfo.Name+'\',
+                                       rDest+FileInfo.Name+'\', wild);
+                    end
+               else if MatchesMask(FileInfo.Name, wild)
+                    then inc(myData.totalfiles);
+
+           end;
+          Error :=FindNext(FileInfo);
+        end;
+        FindClose(FileInfo);
+    end;
+
+begin
+     xSourcePath :=AdjustPath(SourcePath);
+     xDestPath :=AdjustPath(DestPath);
+
+     myData.totalfiles :=0;
+     myData.currentfile :=0;
+     myData.cancelled :=False;
+     myData.Data :=Data;
+     myData.CopyProgressRoutine :=CopyProgressRoutine;
+     myData.Check_Ask :=mrNone;
+
+     if assigned(CopyProgressRoutine) then
+     begin
+          int0.QuadPart :=0;
+          CopyProgressRoutine(Data, 0, 0,
+                              'Preparing for Copy...', int0, int0, myData.Cancelled);
+          countDir(xSourcePath, xDestPath, wild);
+          CopyProgressRoutine(Data, myData.totalfiles, 0,
+                              'Starting Copy...', int0, int0, myData.Cancelled);
+      end;
+
+     copyDir(xSourcePath, xDestPath, wild);
+     if assigned(CopyProgressRoutine)
+     then CopyProgressRoutine(Data, myData.totalfiles, 0,
+                              'Copy completed...', int0, int0, myData.Cancelled);
+end;
+
+procedure CopyFile(SourceFile, DestPath :String; OnExistingFile :Integer; DestFileName :String='';
+                   Data :Pointer=Nil; CopyProgressRoutine :TCopyPathProgressRoutine=Nil);
+var
+   xDestPath,
+   xDestFileName :String;
+   myData        :TCopyPathData;
+   int0          :LARGE_INTEGER;
+
+begin
+     xDestPath :=AdjustPath(DestPath);
+
+     if (DestFileName='')
+     then xDestFileName :=ExtractFilename(SourceFile)
+     else xDestFileName :=ExtractFilename(DestFileName);
+
+     myData.totalfiles :=1;
+     myData.currentfile :=0;
+     myData.cancelled :=False;
+     myData.Data :=Data;
+     myData.CopyProgressRoutine :=CopyProgressRoutine;
+     myData.Check_Ask :=mrNone;
+
+     if assigned(CopyProgressRoutine) then
+     begin
+          int0.QuadPart :=0;
+          CopyProgressRoutine(Data, myData.totalfiles, 0,
+                              'Starting Copy...', int0, int0, myData.Cancelled);
+     end;
+     myData.FileName :=SourceFile;
+     myData.currentfile :=1;
+     if ForceDirectories(xDestPath)
+     then begin
+               if (CheckExisting(SourceFile, xDestPath+xDestFileName, OnExistingFile,
+                                myData.Check_Ask))
+               then CopyFileEx(PChar(SourceFile),
+                          PChar(xDestPath+xDestFileName),
+                          @internalProgress, @myData, Nil,
+                          COPY_FILE_RESTARTABLE);
+
+               if assigned(CopyProgressRoutine)
+               then CopyProgressRoutine(Data, myData.totalfiles, 0,
+                              'Copy completed...', int0, int0, myData.Cancelled);
+          end
+     else raise Exception.Create('Cannot copy Files on '+xDestPath);
+end;
+
+procedure DeleteDir(BaseDir:String; SelName :String; Recursive, RemoveDirs :Boolean);
+
+   procedure _DeleteDir(BaseDir:String; SelName :String; Recursive, RemoveDirs :Boolean);
+   Var
+      SFile,
+      SDir  :TSearchRec;
+      Error :Integer;
+
+   begin
+     //Display('Deleting Dir '+BaseDir+'\'+SelName);
+     if (BaseDir[Length(BaseDir)]<>'\')
+     then BaseDir := BaseDir + '\';
+
+     Error :=FindFirst(BaseDir+Selname, faOnlyFile, Sfile);
+     While (Error=0) Do
+     begin
+          if (SFile.Name[1]<>'.') and
+             not(Sfile.Attr in[faDirectory..faAnyDir])
+          then DeleteFile(BaseDir+SFile.Name);
+
+          Error :=FindNext(SFile);
+     end;
+     FindClose(SFile);
+     if Recursive then
+     begin
+          Error :=FindFirst(BaseDir+'*.*', faAnyDir, SDir);
+          While (Error=0) Do
+          begin
+               if (SDir.Name[1]<>'.') and
+                  (SDir.Attr in[faDirectory..faAnyDir])
+               then begin
+                         DeleteDir(BaseDir+Sdir.Name, SelName, Recursive, RemoveDirs);
+                         if RemoveDirs
+                         then RemoveDirectory(PChar(BaseDir+Sdir.Name));
+                    end;
+
+               Error :=FindNext(SDir);
+           end;
+          FindClose(SDir);
+      end;
+   end;
+
+begin
+     _DeleteDir(BaseDir, SelName, Recursive, RemoveDirs);
+     if RemoveDirs
+     then RemoveDirectory(PChar(BaseDir));
+end;
+
+function AdjustPath(Path :String) :String;
+begin
+     if Path[Length(Path)]<>'\'
+     then Result :=Path+'\'
+     else Result :=Path;
+end;
+
+end.

+ 157 - 0
LuaEdit/LuaCore/Common/FileVer.pas

@@ -0,0 +1,157 @@
+unit FileVer;
+
+interface
+Uses Windows, SysUtils, Classes, Dialogs, Controls, FileCtrl;
+
+function GetFileVerLang(FileName :String; var Lang :String) :String;
+
+// Return :    -1 Version1 < Version2
+//              0 Version1 = Version2
+//             +1 Version1 > Version2
+function CompareVer(Version1, Version2 :String) :Integer;
+function InstallFile(FilesList :TStringList;
+                     SourceDir, DestDir, SourceFile :String) :Boolean;
+
+implementation
+
+Type
+    TL_DWord =packed record
+                 Hi :Word;
+                 Lo :Word;
+              end;
+    PL_DWord =^TL_DWord;
+
+function GetFileVerLang(FileName :String; var Lang :String) :String;
+Var
+   viResult     :DWord;
+   verSize      :Integer;
+   verBuff,
+   verResult    :Pointer;
+   verLang      :PL_DWord;
+   verLangStr   :String;
+
+begin
+     Result  :='?';
+     Lang :='?';
+     verBuff :=Nil;
+     verResult :=Nil;
+     try
+        verSize :=GetFileVersionInfoSize(PChar(FileName), viResult);
+        if (verSize>0) then
+        begin
+             GetMem(verBuff, verSize+2);
+
+             GetFileVersionInfo(PChar(FileName), 0, verSize, verBuff);
+             VerQueryValue(verBuff, PChar('\VarFileInfo\Translation'),
+                      Pointer(verLang), viResult);
+             verLangStr :=IntToHex(verLang^.Hi, 4)+IntToHex(verLang^.Lo, 4);
+             SetLength(Lang, MAX_PATH);
+             VerLanguageName(DWord(verLang^), PChar(Lang), MAX_PATH);
+             Lang :=PChar(Lang);
+
+             VerQueryValue(verBuff, PChar('\StringFileInfo\'+verLangStr+'\FileVersion'),
+                      verResult, viResult);
+             Result :=PChar(verResult);
+        end;
+     finally
+        if (verBuff<>Nil) then FreeMem(verBuff);
+     end;
+end;
+
+function CompareVer(Version1, Version2 :String) :Integer;
+Var
+   ver1, ver2 :String;
+   pos1, pos2 :Integer;
+   last       :Boolean;
+
+begin
+     last :=False;
+     repeat
+           pos1 :=Pos('.', Version1);
+           pos2 :=Pos('.', Version2);
+           if (pos1>1)
+           then begin
+                     ver1 :=Copy(Version1, 1, pos1-1);
+                     Delete(Version1, 1, pos1);
+                end
+           else begin
+                     ver1 :=Version1;
+                     Version1 :='';
+                     last :=True;
+                end;
+           if (pos2>1)
+           then begin
+                     ver2 :=Copy(Version2, 1, pos2-1);
+                     Delete(Version2, 1, pos2);
+                end
+           else begin
+                     ver2 :=Version2;
+                     Version2 :='';
+                     last :=True;
+                end;
+           if (ver1<ver2)
+           then Result := -1
+           else begin
+                     if (ver1=ver2)
+                     then begin
+                                Result := 0;
+                                if last then
+                                begin
+                                     if (Version1<>'')
+                                     then Result := 1  //esempio : 1.0.x è maggiore di 1.0
+                                     else  if (Version2<>'')
+                                           then Result := -1;
+                                end;
+                           end
+                     else Result := 1;
+                end;
+     Until (Result<>0) or last;
+end;
+
+function InstallFile(FilesList :TStringList;
+                     SourceDir, DestDir, SourceFile :String) :Boolean;
+Var
+   Ver1,
+   Ver2,
+   Lang1,
+   Lang2        :String;
+
+
+begin
+     Result :=True;
+
+(*   Ma cumu mai nun funziona................?
+     M'a 'e fari sempri a manu????
+
+    viResult :=VerInstallFile(0,
+                           PChar(SourceFile), PChar(SourceFile),
+                           PChar(SourceDir), PChar(DestDir),
+                           PChar(viPrevFile), PChar(viTempFile), viSizeTemp);
+
+     Result :=Not((viResult and VIF_SRCOLD<>0) or
+                  (viResult and VIF_DIFFLANG<>0) or
+                  (viResult and VIF_DIFFCODEPG<>0));
+     if Not(Result) then
+*)
+     if FileExists(DestDir+SourceFile) then
+     begin
+          Ver1  :=GetFileVerLang(DestDir+SourceFile, Lang1);
+          Ver2  :=GetFileVerLang(SourceDir+SourceFile, Lang2);
+
+          Result :=(MessageDlg('Overwrite File '+DestDir+SourceFile+#13#10+
+                         '     Version= '+Ver1+' Language= '+Lang1+#13#10+
+                         'With Version= '+Ver2+' Language= '+Lang2+#13#10, mtConfirmation, [mbYes, mbNo], 0)
+                  =mrYes);
+     end;
+     if Result then
+     begin
+          ForceDirectories(ExtractFilePath(DestDir+SourceFile));
+          Result :=CopyFile(PChar(SourceDir+SourceFile),
+                            PChar(DestDir+SourceFile), False);
+          if (FilesList<>Nil) then FilesList.Add(DestDir+SourceFile);
+      end;
+end;
+
+
+end.
+ 

+ 664 - 0
LuaEdit/LuaCore/Common/MGList.pas

@@ -0,0 +1,664 @@
+//******************************************************************************
+//***                     COMMON DELPHI FUNCTIONS                            ***
+//***                                                                        ***
+//***    (c) Beppe Grimaldi, Massimo Magnano 11-11-2004.                     ***
+//***                                                                        ***
+//***                                                                        ***
+//******************************************************************************
+//  File        : MGList.pas      REV. 1.6   (13-09-2006)
+//
+//  Description : Implementation of an Optimazed and Polimorphic List.
+//
+//******************************************************************************
+
+unit MGList;
+
+interface
+
+Type
+  PDataExt = ^TDataExt;
+  TDataExt = record
+     Data         :Pointer;
+     Prev         :PDataExt;
+     Next         :PDataExt;
+  end;
+
+  //I Tag sono necessari xche' Non posso leggere le variabili che stanno nello Stack
+  //quindi devo passare le variabile necessarie alle funzioni locali così
+  TLocalCompareFunction = function (Tag :Integer; ptData1, ptData2 :Pointer) :Boolean;
+  TLocalWalkFunction = procedure (Tag :Integer; ptData :Pointer);
+  TObjCompareFunction = function (Tag :Integer; ptData1, ptData2 :Pointer) :Boolean of object;
+  PObjCompareFunction = ^TObjCompareFunction;
+  TObjWalkFunction = procedure (Tag :Integer; ptData :Pointer) of object;
+
+
+  TMGList = class
+    protected
+        rListInit,
+        rListEnd,
+        rCurrent     :PDataExt;
+        rCount       :Integer;
+
+        function Get(Index: Integer): Pointer;
+        function InternalDelete(Item :PDataExt) :PDataExt; overload;
+        function InternalFind(pData :Pointer; ATag :Integer; CompareFunction : TLocalCompareFunction=nil) :PDataExt; virtual;
+        function PutInRightPosition(newElem :PDataExt; ATag :Integer; CompareFunction : TLocalCompareFunction=nil) :Integer; overload; virtual;
+        function PutInRightPosition(newElem :PDataExt; ATag :Integer; CompareFunction : TObjCompareFunction) :Integer; overload; virtual;
+        function allocData :Pointer; virtual;
+        procedure deallocData(pData :Pointer); virtual;
+        function RefreshOK(pData :Pointer) : Boolean; virtual;
+    public
+        constructor Create; virtual;
+        destructor Destroy; override;
+
+        function Find(pData :Pointer; ATag :Integer; CompareFunction : TLocalCompareFunction=nil): Integer; overload;
+        function Find(pData :Pointer; ATag :Integer; CompareFunction : TObjCompareFunction): Integer; overload;
+        function Find(const Args: array of Variant): Pointer; overload; virtual;
+        function ExtFind(pData :Pointer; ATag :Integer; CompareFunction : TLocalCompareFunction=nil): Pointer; overload;
+        function ExtFind(pData :Pointer; ATag :Integer; CompareFunction : TObjCompareFunction): Pointer; overload;
+        procedure Walk(ATag :Integer; WalkFunction : TLocalWalkFunction); overload;
+        procedure Walk(ATag :Integer; WalkFunction : TObjWalkFunction); overload;
+        procedure WalkAndRefresh(ATag :Integer; WalkFunction : TLocalWalkFunction); overload;
+        procedure WalkAndRefresh(ATag :Integer; WalkFunction : TObjWalkFunction); overload;
+
+        function Add :Pointer; overload;
+        function Insert(pData :Pointer; ATag :Integer; CompareFunction : TLocalCompareFunction=nil) :Integer; overload;
+        function Insert(pData :Pointer; ATag :Integer; CompareFunction : TObjCompareFunction) :Integer; overload;
+        function Delete(Index :Integer) :Boolean; overload;
+        function Delete(pData :Pointer; ATag :Integer; CompareFunction : TLocalCompareFunction=Nil) :Boolean; overload;
+        function Delete(pData :Pointer; ATag :Integer; CompareFunction : TObjCompareFunction) :Boolean; overload;
+        procedure Exchange(pData1, pData2 :Pointer); overload; virtual;
+
+        procedure Clear;
+        procedure Refresh;
+
+        function FindFirst: Pointer; virtual;
+        function FindNext : Pointer; virtual;
+        function GetCurrent : Pointer; virtual;
+        function GetData(DataPointer :Pointer; DataName :String) :Variant; virtual;
+        function DeleteCurrent :Boolean;
+        procedure FindClose; virtual;
+
+        property Count :Integer read rCount;
+        property Items [Index :Integer] :Pointer read Get;
+  end;
+
+  TMGListClass = class of TMGList;
+
+
+  TMGObjectWithCreate = class(TObject)
+  public
+     constructor Create(dummy :Boolean); virtual;
+  end;
+
+  TObjectWCClass = class of TMGObjectWithCreate;
+
+  TMGObject_List = class(TMGList)
+  protected
+       function allocData :Pointer; override;
+       procedure deallocData(pData :Pointer); override;
+       function GetObjectClass :TObjectWCClass; virtual; abstract;
+  end;
+
+  TMGList_List = class(TMGList)
+  protected
+       function allocData :Pointer; override;
+       procedure deallocData(pData :Pointer); override;
+       function GetObjectClass :TMGListClass; virtual; abstract;
+  end;
+
+
+implementation
+
+Type
+    TLocalToObjData_Compare = record
+        Tag  :Integer;
+        Func :TObjCompareFunction;
+    end;
+    PLocalToObjData_Compare = ^TLocalToObjData_Compare;
+
+    TLocalToObjData_Walk = record
+        Tag  :Integer;
+        Func :TObjWalkFunction;
+    end;
+    PLocalToObjData_Walk = ^TLocalToObjData_Walk;
+
+
+function _localToObj_Compare(xTag :Integer; ptData1, ptData2 :Pointer) :Boolean;
+begin
+     Result := PLocalToObjData_Compare(xTag).Func(
+                                     PLocalToObjData_Compare(xTag).Tag,
+                                     ptData1, ptData2);
+end;
+
+procedure _localToObj_Walk(xTag :Integer; ptData :Pointer);
+begin
+     PLocalToObjData_Walk(xTag).Func(PLocalToObjData_Walk(xTag).Tag, ptData);
+end;
+
+function AllocData_Compare(Tag :Integer; Func :TObjCompareFunction) :PLocalToObjData_Compare;
+begin
+     GetMem(Result, sizeOf(TLocalToObjData_Compare));
+     Result^.Tag :=Tag;
+     Result^.Func :=Func;
+end;
+
+function AllocData_Walk(Tag :Integer; Func :TObjWalkFunction) :PLocalToObjData_Walk;
+begin
+     GetMem(Result, sizeOf(TLocalToObjData_Walk));
+     Result^.Tag :=Tag;
+     Result^.Func :=Func;
+end;
+
+function CompByData(xTag :Integer; ptData1, ptData2 :Pointer) :Boolean;
+begin
+     Result := (ptData1 = ptData2);
+end;
+
+
+
+// =============================================================================
+
+constructor TMGList.Create;
+begin
+   rCount := 0;
+   rListInit := Nil;
+   rListEnd := Nil;
+   rCurrent := Nil;
+end;
+
+destructor TMGList.Destroy;
+begin
+   Clear;
+end;
+
+function TMGList.allocData :Pointer;
+begin
+     Result :=Nil;
+end;
+
+procedure TMGList.deallocData(pData :Pointer);
+begin
+end;
+
+function TMGList.RefreshOK(pData :Pointer) : Boolean;
+begin
+     Result :=True;
+end;
+
+procedure TMGList.Clear;
+var
+   pIndex :PDataExt;
+begin
+   while (rListInit <> Nil) do
+     begin
+        pIndex := rListInit;
+        rListInit := rListInit^.Next;
+        deallocData(pIndex^.Data);
+        Dispose(pIndex);
+     end;
+   rListInit := Nil;
+   rListEnd := Nil;
+   rCount := 0;
+end;
+
+procedure TMGList.Refresh;
+var
+   pIndex :PDataExt;
+begin
+   pIndex := rListInit;
+   while (pIndex <> Nil) do
+     begin
+        if RefreshOK(pIndex^.Data)
+          then pIndex := pIndex^.Next
+          else begin
+                  if (pIndex^.Next = Nil)  // se è l'ultimo elemento..
+                    then rListEnd := pIndex^.Prev;
+                  pIndex := InternalDelete(pIndex);
+               end;
+     end;
+end;
+
+function TMGList.FindFirst: Pointer;
+begin
+     if (rCurrent=Nil)
+      then begin
+                rCurrent :=rListInit;
+                Result :=GetCurrent;
+           end
+      else Result :=Nil;
+end;
+
+function TMGList.FindNext : Pointer;
+begin
+     if (rCurrent<>Nil)
+      then begin
+                rCurrent :=rCurrent^.Next;
+                Result :=GetCurrent;
+           end
+      else Result :=Nil;
+end;
+
+function TMGList.GetCurrent : Pointer;
+begin
+     if (rCurrent=Nil)
+     then Result :=Nil
+     else Result :=rCurrent^.Data;
+end;
+
+function TMGList.GetData(DataPointer :Pointer; DataName :String) :Variant;
+begin
+     Result :=Variant(Integer(DataPointer));
+end;
+
+function TMGList.DeleteCurrent :Boolean;
+begin
+   Result := False;
+   if (rCurrent <> Nil) then
+     begin
+        rCurrent := InternalDelete(rCurrent);
+        Result := True;
+     end;
+end;
+
+procedure TMGList.FindClose;
+begin
+     rCurrent :=Nil;
+end;
+
+function TMGList.Get(Index: Integer): Pointer;
+var
+   I :Integer;
+   pIndex :PDataExt;
+
+begin
+   Result := Nil;
+   if ((Index >= 0) and (Index < rCount)) then
+     begin
+        pIndex := rListInit;
+        for i:=0 to Index-1 do
+          pIndex := pIndex^.Next;
+        Result := pIndex^.Data;
+     end;
+end;
+
+function TMGList.Find(pData :Pointer; ATag :Integer; CompareFunction : TLocalCompareFunction=nil): Integer;
+var
+   i :Integer;
+   Found :Boolean;
+   pIndex :PDataExt;
+
+begin
+   if not(Assigned(CompareFunction))
+   then CompareFunction :=CompByData;
+
+   Result := -1;
+   i := 0;
+   Found := False;
+   pIndex := rListInit;
+   while ((i < rCount) and not Found) do
+     if CompareFunction(ATag, pData, pIndex^.Data)
+       then begin
+               Result := i;
+               Found := True;
+            end
+       else begin
+               Inc(i);
+               pIndex := pIndex^.Next;
+            end;
+end;
+
+function TMGList.Find(pData :Pointer; ATag :Integer; CompareFunction : TObjCompareFunction): Integer;
+Var
+  auxPointer :PLocalToObjData_Compare;
+
+begin
+     auxPointer :=AllocData_Compare(ATag, CompareFunction);
+     Result := Find(pData, Integer(auxPointer), _LocalToObj_Compare);
+     FreeMem(auxPointer);
+end;
+
+function TMGList.Find(const Args: array of Variant): Pointer;
+begin
+     Result :=Nil;
+end;
+
+function TMGList.ExtFind(pData :Pointer; ATag :Integer; CompareFunction : TLocalCompareFunction=nil): Pointer;
+var
+   Found  :Boolean;
+   pIndex :PDataExt;
+
+begin
+   if not(Assigned(CompareFunction))
+   then CompareFunction :=CompByData;
+
+   Result := Nil;
+   Found := False;
+   pIndex := rListInit;
+   while ((pIndex <> Nil) and not Found) do
+     if CompareFunction(ATag, pData, pIndex^.Data)
+       then begin
+               Result := pIndex^.Data;
+               Found := True;
+            end
+       else pIndex := pIndex^.Next;
+end;
+
+
+function TMGList.ExtFind(pData :Pointer; ATag :Integer; CompareFunction : TObjCompareFunction): Pointer;
+Var
+  auxPointer :PLocalToObjData_Compare;
+
+begin
+     auxPointer :=AllocData_Compare(ATag, CompareFunction);
+     Result := ExtFind(pData, Integer(auxPointer), _LocalToObj_Compare);
+     FreeMem(auxPointer);
+end;
+
+procedure TMGList.Walk(ATag :Integer; WalkFunction : TLocalWalkFunction);
+var
+   pIndex :PDataExt;
+
+begin
+     pIndex := rListInit;
+     while (pIndex <> Nil) do
+     begin
+          WalkFunction(ATag, pIndex^.Data);
+          pIndex := pIndex^.Next;
+     end;
+end;
+
+procedure TMGList.Walk(ATag :Integer; WalkFunction : TObjWalkFunction);
+Var
+  auxPointer :PLocalToObjData_Walk;
+
+begin
+     auxPointer :=AllocData_Walk(ATag, WalkFunction);
+     Walk(Integer(auxPointer), _LocalToObj_Walk);
+     FreeMem(auxPointer);
+end;
+
+procedure TMGList.WalkAndRefresh(ATag :Integer; WalkFunction : TLocalWalkFunction);
+var
+   pIndex :PDataExt;
+
+begin
+     pIndex := rListInit;
+     while (pIndex <> Nil) do
+     begin
+          if RefreshOk(pIndex^.Data)
+          then begin
+                    WalkFunction(ATag, pIndex^.Data);
+                    pIndex := pIndex^.Next;
+               end
+          else begin
+                  if (pIndex^.Next = Nil)  // se è l'ultimo elemento..
+                    then rListEnd := pIndex^.Prev;
+                  pIndex := InternalDelete(pIndex);
+               end;
+     end;
+end;
+
+procedure TMGList.WalkAndRefresh(ATag :Integer; WalkFunction : TObjWalkFunction);
+Var
+  auxPointer :PLocalToObjData_Walk;
+
+begin
+     auxPointer :=AllocData_Walk(ATag, WalkFunction);
+     WalkAndRefresh(Integer(auxPointer), _LocalToObj_Walk);
+     FreeMem(auxPointer);
+end;
+
+
+function TMGList.Add :Pointer;
+var
+   newElem :PDataExt;
+
+begin
+   new(newElem);
+   fillchar(newElem^, sizeof(TDataExt), 0);
+   newElem^.Data := allocData;
+
+   if (rListEnd = Nil)
+     then begin
+             rListInit := newElem;
+             rListEnd := newElem;
+          end
+     else begin
+             rListEnd^.Next := newElem;
+             newElem^.Prev := rListEnd;
+             rListEnd := newElem;
+          end;
+   Inc(rCount);
+   Result := newElem^.Data;
+end;
+
+function TMGList.PutInRightPosition(newElem :PDataExt; ATag :Integer; CompareFunction : TLocalCompareFunction) :Integer;
+var
+   Found   :Boolean;
+   pIndex  :PDataExt;
+
+begin
+   if not(Assigned(CompareFunction))
+   then CompareFunction :=CompByData;
+
+   Result := 0;
+   if (rListInit = Nil)
+     then begin
+             rListInit := newElem;
+             rListEnd := newElem;
+          end
+     else begin
+             Found := False;
+             pIndex := rListInit;
+             repeat
+               if CompareFunction(ATag, newElem^.Data, pIndex^.Data)
+                 then begin
+                         // uso 'newElem^.Prev' per conservare il puntatore al record precedente..
+                         newElem^.Prev := pIndex;
+                         pIndex := pIndex^.Next;
+                      end
+                 else Found := True;
+               Inc(Result);
+             until ((pIndex = Nil) or Found);
+
+             if (newElem^.Prev = Nil)  // inserisco in prima posizione..
+               then rListInit := newElem
+               else newElem^.Prev^.Next := newElem;
+             newElem^.Next := pIndex;
+             if (pIndex <> Nil)
+               then pIndex^.Prev := newElem
+               else rListEnd := newElem;  // inserisco in ultima posizione..
+          end;
+end;
+
+function TMGList.PutInRightPosition(newElem :PDataExt; ATag :Integer; CompareFunction : TObjCompareFunction) :Integer;
+Var
+  auxPointer :PLocalToObjData_Compare;
+
+begin
+     auxPointer :=AllocData_Compare(ATag, CompareFunction);
+     Result := PutInRightPosition(newElem, Integer(auxPointer), _LocalToObj_Compare);
+     FreeMem(auxPointer);
+end;
+
+function TMGList.Insert(pData :Pointer; ATag :Integer; CompareFunction : TLocalCompareFunction=Nil) :Integer;
+var
+   newElem :PDataExt;
+   
+begin
+   if not(Assigned(CompareFunction))
+   then CompareFunction :=CompByData;
+
+   new(newElem);
+   fillchar(newElem^, sizeof(TDataExt), 0);
+   newElem^.Data :=pData;
+
+   Result := PutInRightPosition(pData, ATag, CompareFunction);
+   Inc(rCount);
+end;
+
+function TMGList.Insert(pData :Pointer; ATag :Integer; CompareFunction : TObjCompareFunction) :Integer;
+Var
+  auxPointer :PLocalToObjData_Compare;
+
+begin
+     auxPointer :=AllocData_Compare(ATag, CompareFunction);
+     Result := Insert(pData, Integer(auxPointer), _LocalToObj_Compare);
+     FreeMem(auxPointer);
+end;
+
+
+function TMGList.Delete(Index :Integer) :Boolean;
+var
+   i      :Integer;
+   pIndex :PDataExt;
+
+begin
+   Result := False;
+   if ((Index >= 0) and (Index < rCount)) then
+     begin
+        pIndex := rListInit;
+        for i:=0 to Index-1 do
+          pIndex := pIndex^.Next;
+
+        if (pIndex = Nil)
+          then InternalDelete(rListEnd)
+          else InternalDelete(pIndex);
+
+        Result := True;
+     end;
+end;
+
+function TMGList.Delete(pData :Pointer; ATag :Integer; CompareFunction : TLocalCompareFunction=Nil) :Boolean;
+Var
+   toDel :PDataExt;
+
+begin
+     if not(Assigned(CompareFunction))
+     then CompareFunction :=CompByData;
+
+     toDel := InternalFind(pData, ATag, CompareFunction);
+     Result := (toDel<>Nil);
+     if Result
+     then InternalDelete(toDel);
+end;
+
+function TMGList.Delete(pData :Pointer; ATag :Integer; CompareFunction : TObjCompareFunction) :Boolean;
+Var
+  auxPointer :PLocalToObjData_Compare;
+
+begin
+     auxPointer :=AllocData_Compare(ATag, CompareFunction);
+     Result := Delete(pData, Integer(auxPointer), _LocalToObj_Compare);
+     FreeMem(auxPointer);
+end;
+
+procedure TMGList.Exchange(pData1, pData2 :Pointer);
+var
+   pIndex,
+   pIndexData1,
+   pIndexData2  :PDataExt;
+   xData        :Pointer;
+
+
+begin
+   pIndex := rListInit;
+   pIndexData1 :=Nil;
+   pIndexData2 :=Nil;
+   while ((pIndex <> Nil) and ((pIndexData1=Nil) or (pIndexData2=Nil))) do
+   begin
+        if (pIndex^.Data=pData1)
+        then pIndexData1 :=pIndex
+        else if (pIndex^.Data=pData2)
+             then pIndexData2 :=pIndex;
+
+        pIndex := pIndex^.Next;
+   end;
+
+   if ((pIndexData1<>Nil) and (pIndexData2<>Nil)) then
+   begin
+        xData := pIndexData1^.Data;
+        pIndexData1^.Data := pIndexData2^.Data;
+        pIndexData2^.Data := xData;
+   end;
+end;
+
+
+function TMGList.InternalDelete(Item :PDataExt) :PDataExt;
+var
+   P :PDataExt;
+begin
+   Result := Nil;
+   P := PDataExt(Item);
+   if (P <> Nil) then
+     begin
+        if (P^.Prev <> Nil)
+          then P^.Prev^.Next := P^.Next
+          else rListInit := P^.Next;
+        if (P^.Next <> Nil)
+          then P^.Next^.Prev := P^.Prev
+          else rListEnd := P^.Prev;  // sto cancellando l'ultimo elemento..
+
+        Result := P^.Prev;
+        deallocData(P^.Data);
+        Dispose(P);
+        Dec(rCount);
+     end;
+end;
+
+
+function TMGList.InternalFind(pData :Pointer; ATag :Integer; CompareFunction : TLocalCompareFunction=nil) :PDataExt;
+var
+   Found  :Boolean;
+   pIndex :PDataExt;
+
+begin
+   if not(Assigned(CompareFunction))
+   then CompareFunction :=CompByData;
+
+   Result := Nil;
+   Found := False;
+   pIndex := rListInit;
+   while ((pIndex <> Nil) and not Found) do
+     if CompareFunction(ATag, pData, pIndex^.Data)
+       then begin
+               Result := pIndex;
+               Found := True;
+            end
+       else pIndex := pIndex^.Next;
+end;
+
+//==============================================================================
+//  TMGObject_List = class(TMGList)
+
+constructor TMGObjectWithCreate.Create(dummy :Boolean);
+begin
+     inherited Create;
+end;
+
+function TMGObject_List.allocData :Pointer;
+begin
+     Result :=GetObjectClass.Create(true); //Why Tobject.Create is not virtual???
+end;
+
+procedure TMGObject_List.deallocData(pData :Pointer);
+begin
+     TObject(pData).Free;
+end;
+
+//==============================================================================
+//  TMGList_List = class(TMGList)
+
+function TMGList_List.allocData :Pointer;
+begin
+     Result :=GetObjectClass.Create;
+end;
+
+procedure TMGList_List.deallocData(pData :Pointer);
+begin
+     TMGList(pData).Free;
+end;
+
+
+end.

+ 459 - 0
LuaEdit/LuaCore/Common/MGRegistry.pas

@@ -0,0 +1,459 @@
+//******************************************************************************
+//***                   COMMON DELPHI FUNCTIONS                              ***
+//***                                                                        ***
+//***        (c) Massimo Magnano, Beppe Grimaldi 2004-2005                   ***
+//***                                                                        ***
+//***                                                                        ***
+//******************************************************************************
+//  File        : MGRegistry.pas
+//
+//  Description : Extensions on TRegistry class
+//                    Support for Read\Write Components,
+//                    TFont,
+//                    MultiLine Text
+//
+//******************************************************************************
+
+unit MGRegistry;
+
+interface
+
+{$define TYPE_INFO_1}
+
+Uses Windows, Registry, SysUtils, Classes, Graphics, TypInfo;
+
+Type
+    TRegFont = packed record
+       Name    :ShortString;
+       Size    :Byte;
+       Style   :Byte;
+       Charset :Byte;
+       Color   :TColor;
+    end;
+
+    TPersistentClasses = class of TPersistent;
+
+    TMGRegistry =class(TRegistry)
+    protected
+       function ReadWriteClass(Read :Boolean; AClass :TPersistent) :Boolean; virtual;
+    public
+       function ReadBool(Default :Boolean; const Name: string): Boolean; overload;
+       function ReadCurrency(Default :Currency; const Name: string): Currency; overload;
+       function ReadDate(Default :TDateTime; const Name: string): TDateTime; overload;
+       function ReadDateTime(Default :TDateTime; const Name: string): TDateTime; overload;
+       function ReadFloat(Default :Double; const Name: string): Double; overload;
+       function ReadInteger(Default :Integer; const Name: string): Integer; overload;
+       function ReadString(Default :string; AcceptEmpty :Boolean;  const Name: string): string; overload;
+       function ReadTime(Default :TDateTime; const Name: string): TDateTime; overload;
+       procedure ReadBinaryDataFromFile(FileName :String; var Buffer :Pointer; var BufSize :Integer);
+       procedure ReadBinaryDataFromString(theString :String; var Buffer :Pointer; var BufSize :Integer);
+       function ReadFont(const Name: string; var AFont :TFont): Boolean;
+       procedure WriteFont(const Name: string; Value :TFont);
+       function ReadClass(var AClass :TPersistent; AClasses :TPersistentClasses): Boolean;
+       function WriteClass(AClass :TPersistent): Boolean;
+       function ReadDFMClass(Name :String; AClass :TPersistent): Boolean;
+       function WriteDFMClass(Name :String; AClass :TPersistent): Boolean;
+       procedure WriteMultiLineString(Name, Value: String);
+       function ReadMultiLineString(const Name: string): string;
+    end;
+
+implementation
+
+
+type
+    TReadWritePersist = class (TComponent)
+    private
+      rData :TPersistent;
+    published
+      property Data :TPersistent read rData write rData;
+    end;
+
+function TMGRegistry.ReadBool(Default :Boolean; const Name: string): Boolean;
+begin
+     try
+        Result :=ReadBool(Name);
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+function TMGRegistry.ReadCurrency(Default :Currency; const Name: string): Currency;
+begin
+     try
+        Result :=ReadCurrency(Name);
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+function TMGRegistry.ReadDate(Default :TDateTime; const Name: string): TDateTime;
+begin
+     try
+        Result :=ReadDate(Name);
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+function TMGRegistry.ReadDateTime(Default :TDateTime; const Name: string): TDateTime;
+begin
+     try
+        Result :=ReadDateTime(Name);
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+function TMGRegistry.ReadFloat(Default :Double; const Name: string): Double;
+begin
+     try
+        Result :=ReadFloat(Name);
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+function TMGRegistry.ReadInteger(Default :Integer; const Name: string): Integer;
+begin
+     try
+        Result :=ReadInteger(Name);
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+function TMGRegistry.ReadString(Default :string; AcceptEmpty :Boolean; const Name: string): string;
+begin
+     try
+        if (ValueExists(Name))
+          then begin
+                  Result := ReadString(Name);
+                  if ((Result = '') and not AcceptEmpty)
+                    then Result := Default;
+               end
+          else Result := Default;
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+function TMGRegistry.ReadTime(Default :TDateTime; const Name: string): TDateTime;
+begin
+     try
+        Result :=ReadTime(Name);
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+procedure TMGRegistry.ReadBinaryDataFromFile(FileName :String; var Buffer :Pointer; var BufSize :Integer);
+Var
+   theFile :TFileStream;
+
+begin
+     BufSize :=0;
+     Buffer :=Nil;
+     theFile :=Nil;
+     try
+        theFile :=TFileStream.Create(FileName, fmOpenRead);
+        BufSize :=theFile.Size;
+        GetMem(Buffer, BufSize);
+        theFile.Read(Buffer, BufSize);
+        theFile.Free; theFile :=Nil;
+     except
+        On E:Exception do
+        begin
+             if Buffer<>Nil then FreeMem(Buffer);
+             if theFile<>Nil then theFile.Free;
+             Buffer :=Nil;
+             BufSize :=0;
+        end;
+     end;
+end;
+
+procedure TMGRegistry.ReadBinaryDataFromString(theString :String; var Buffer :Pointer; var BufSize :Integer);
+Var
+   indexStr,
+   indexPtr :Integer;
+
+begin
+     BufSize :=Length(theString) div 2;
+     SetLength(theString, BufSize*2); //la stringa deve essere di lunghezza pari
+     GetMem(Buffer, BufSize);
+     indexStr :=1;
+     for indexPtr :=0 to BufSize-1 do
+     begin
+          PChar(Buffer)[indexPtr] :=Char(StrToInt('$'+Copy(theString, indexStr, 2)));
+          inc(indexStr, 2);
+     end;
+end;
+
+function TMGRegistry.ReadFont(const Name: string; var AFont :TFont) :Boolean;
+var
+   regFont :TRegFont;
+begin
+     Result := False;
+     try
+        if (not assigned(AFont))
+          then AFont := TFont.Create;
+        if (ValueExists(Name))
+          then if (GetDataSize(Name) = sizeOf(TRegFont))
+                 then begin
+                         ReadBinaryData(Name, regFont, sizeOf(TRegFont));
+                         AFont.Name := regFont.Name;
+                         AFont.Size := regFont.Size;
+                         AFont.Style := TFontStyles(regFont.Style);
+                         AFont.Charset := regFont.Charset;
+                         AFont.Color := regFont.Color;
+                         Result := True;
+                      end;
+     except
+        On E:Exception do begin end;
+     end;
+end;
+
+procedure TMGRegistry.WriteFont(const Name: string; Value :TFont);
+var
+   regFont :TRegFont;
+begin
+     try
+        if (Value <> Nil)
+          then begin
+                  regFont.Name := Value.Name;
+                  regFont.Size := Value.Size;
+                  regFont.Style := Byte(Value.Style);
+                  regFont.Charset := Value.Charset;
+                  regFont.Color := Value.Color;
+                  WriteBinaryData(Name, regFont, sizeOf(TRegFont));
+               end;
+     except
+        On E:Exception do begin end;
+     end;
+end;
+
+function TMGRegistry.ReadWriteClass(Read :Boolean; AClass :TPersistent) :Boolean;
+Var
+   rPropList :TPropList;
+   PropName  :String;
+   PropValue :Variant;
+   IsClass   :Boolean;
+   i         :Integer;
+
+begin
+     Result := True;
+     try
+          fillchar(rPropList, sizeof(TPropList), 0);
+          TypInfo.GetPropList(AClass.ClassInfo, tkProperties,
+                              PPropList(@rPropList));
+          i := 0;
+          while (rPropList[i] <> Nil) do
+          begin
+             try
+               {$ifdef TYPE_INFO_1}
+                 IsClass :=(rPropList[i]^.PropType^.Kind=tkClass);
+               {$else}
+                 IsClass :=(rPropList[i]^.PropType^^.Kind=tkClass);
+               {$endif}
+               PropName :=rPropList[i]^.Name;
+
+               if not(IsClass) then
+               begin
+                    if Read
+                    then begin
+                              PropValue :=Self.ReadString('', True, PropName);
+                              SetPropValue(AClass, PropName, PropValue);
+                         end
+                    else begin
+                              PropValue :=GetPropValue(AClass, PropName, True);
+                              Self.WriteString(PropName, PropValue);
+                         end;
+               end;
+             except
+                   On E:Exception do Result :=False;
+             end;
+             Inc(i);
+          end;
+     except
+        On E:Exception do Result :=False;
+     end;
+end;
+
+function TMGRegistry.ReadClass(var AClass :TPersistent; AClasses :TPersistentClasses): Boolean;
+begin
+     Result :=False;
+     try
+        if (not assigned(AClass))
+        then begin
+                  AClass := TPersistent(AClasses.Create);
+             end;
+
+        if (AClass<>Nil)
+        then Result :=ReadWriteClass(True, AClass);
+     except
+       On E:Exception do Result :=False;
+     end;
+end;
+
+function TMGRegistry.WriteClass(AClass :TPersistent):Boolean;
+begin
+     Result :=False;
+     if (AClass<>Nil)
+     then Result :=ReadWriteClass(False, AClass);
+end;
+
+function TMGRegistry.ReadDFMClass(Name :String; AClass :TPersistent): Boolean;
+Var
+   MStream,
+   MStreamTXT  :TMemoryStream;
+   xList       :TStringList;
+   toRead      :TComponent;
+
+
+begin
+  Result :=False;
+  try
+     if (AClass is TComponent)
+     then toRead :=TComponent(AClass)
+     else begin
+               if (AClass is TPersistent)
+               then begin
+                         toRead :=TReadWritePersist.Create(Nil);
+                         TReadWritePersist(toRead).Data :=AClass;
+                    end
+               else Exit;
+          end;
+
+     MStream    :=TMemoryStream.Create;
+     MStreamTXT :=TMemoryStream.Create;
+     xList   :=TStringList.Create;
+     try
+        xList.Text :=Self.ReadMultiLineString(Name);
+        xList.SaveToStream(MStreamTXT);
+        MStreamTXT.Position :=0;
+
+        ObjectTextToBinary(MStreamTXT, MStream);
+        MStream.Position :=0;
+        MStream.ReadComponent(toRead);
+        Result :=True;
+     finally
+        MStream.Free;
+        MStreamTXT.Free;
+        xList.Free;
+
+        if (toRead<>AClass)
+        then toRead.Free;
+     end;
+  except
+     On E:Exception do begin end;
+  end;
+end;
+
+function TMGRegistry.WriteDFMClass(Name :String; AClass :TPersistent): Boolean;
+Var
+   MStream,
+   MStreamTXT  :TMemoryStream;
+   xList       :TStringList;
+   toWrite     :TComponent;
+
+begin
+  Result :=False;
+  try
+     if (AClass is TComponent)
+     then toWrite :=TComponent(AClass)
+     else begin
+               if (AClass is TPersistent)
+               then begin
+                         toWrite :=TReadWritePersist.Create(Nil);
+                         TReadWritePersist(toWrite).Data :=AClass;
+                    end
+               else Exit;
+          end;
+
+     MStream    :=TMemoryStream.Create;
+     MStreamTXT :=TMemoryStream.Create;
+     xList   :=TStringList.Create;
+     try
+        MStream.WriteComponent(toWrite);
+        MStream.Position :=0;
+
+        ObjectBinaryToText(MStream, MStreamTXT);
+        MStreamTXT.Position :=0;
+        xList.LoadFromStream(MStreamTXT);
+        Self.WriteMultiLineString(Name, xList.Text);
+        Result :=True;
+     finally
+        MStream.Free;
+        MStreamTXT.Free;
+        xList.Free;
+
+        if (toWrite<>AClass)
+        then toWrite.Free;
+     end;
+  except
+    On E:Exception do begin end;
+  end;
+end;
+
+procedure TMGRegistry.WriteMultiLineString(Name, Value: String);
+Var
+   Buffer :PChar;
+   ch     :Char;
+   i, k   :Integer;
+
+begin
+    Buffer :=Nil;
+    try
+       GetMem(Buffer, Length(Value)+1);
+       k :=0;
+       for i :=1 to Length(Value) do
+       begin
+            ch :=Value[i];
+            case ch of
+            #13 : ch :=#0;
+            #10 : Continue;
+            end;
+            Buffer[k] :=ch;
+            inc(k);
+        end;
+
+       Buffer[k+1] :=#0;
+
+       RegSetValueEx(CurrentKey, PChar(Name), 0, REG_MULTI_SZ, Buffer, k);
+    finally
+       if (Buffer<>Nil)
+       then Freemem(Buffer);
+    end;
+end;
+
+function TMGRegistry.ReadMultiLineString(const Name: string): string;
+Var
+   Buffer  :PChar;
+   ch      :Char;
+   i       :Integer;
+   bufSize :DWord;
+   bufType :DWord;
+
+begin
+    if (RegQueryValueEx(CurrentKey, PChar(Name), Nil, @bufType, Nil, @bufSize)
+       =ERROR_SUCCESS) and (bufType=REG_MULTI_SZ)
+    then begin
+              Buffer :=Nil;
+              try
+                 GetMem(Buffer, bufSize);
+                 RegQueryValueEx(CurrentKey, PChar(Name), Nil, @bufType, PByte(Buffer), @bufSize);
+
+                 for i :=0 to bufSize-2 do
+                 begin
+                      ch :=Buffer[i];
+                      if ch=#0
+                      then Result :=Result+#13#10
+                      else Result :=Result+ch;
+                 end;
+              finally
+                 if (Buffer<>Nil)
+                 then Freemem(Buffer);
+              end;
+         end;
+end;
+
+end.

+ 154 - 0
LuaEdit/LuaCore/Common/RTDebug.pas

@@ -0,0 +1,154 @@
+unit RTDebug;
+
+interface
+Uses Windows, Messages, SysUtils, Classes, MGRegistry;
+
+Const
+     MG_RTD_AddReference  =WM_USER+12123;
+     MG_RTD_DelReference  =MG_RTD_AddReference+1;
+     MG_RTD_GetListHandle =MG_RTD_AddReference+2;
+
+     REG_KEY              ='\Software\MaxM_BeppeG\RTDebug\';
+     REG_LOGFILE          ='Log File';
+     REG_LOGONFILE        ='Log File Enabled';
+
+type
+    TRTDebugParameters =record
+                       processID,
+                       threadID  :DWord;
+                       Level     :Byte;
+                       theString :ShortString;
+                       StrColor  :DWord;
+                 end;
+var
+   LogFileName :String  ='';
+   LogOnFile   :Boolean =False;
+
+function RTAssert(Level :Byte; Condition :Boolean; TrueStr, FalseStr :ShortString;
+                  StrColor :DWord=0) :Boolean; overload;
+function RTAssert(TrueStr :ShortString; StrColor :DWord=0) :Boolean; overload;
+function RTAssert(Condition :Boolean; TrueStr, FalseStr :ShortString; StrColor :DWord=0) :Boolean; overload;
+function RTAssert(Condition :Boolean; TrueStr :ShortString; StrColor :DWord=0) :Boolean; overload;
+
+function RTFileAssert(Filename :ShortString; Condition :Boolean; TrueStr, FalseStr :ShortString) :Boolean;
+function RTFileEmpty(Filename :ShortString) :Boolean;
+function GetLogFileName :String;
+
+implementation
+
+procedure AddLineToList(Level :Byte; theString :ShortString; StrColor :DWord);
+Var
+   pCopyData  :TCopyDataStruct;
+   WinHandle  :HWnd;
+
+begin
+     WinHandle :=FindWindow('TRTDebugMainWin', Nil);
+     if IsWindow(WinHandle) then
+     begin
+          pCopyData.cbData :=SizeOf(TRTDebugParameters);
+          GetMem(pCopyData.lpData, SizeOf(TRTDebugParameters));
+
+          TRTDebugParameters(pCopyData.lpData^).processID :=GetCurrentProcessID;
+          TRTDebugParameters(pCopyData.lpData^).ThreadID :=GetCurrentThreadID;
+          TRTDebugParameters(pCopyData.lpData^).Level :=Level;
+          TRTDebugParameters(pCopyData.lpData^).theString :=theString;
+          TRTDebugParameters(pCopyData.lpData^).StrColor :=StrColor;
+
+          SendMessage(WinHandle, WM_COPYDATA, 0, Integer(@pCopyData));
+          FreeMem(pCopyData.lpData);
+     end;
+
+end;
+
+function RTAssert(Level :Byte; Condition :Boolean; TrueStr, FalseStr :ShortString;
+                  StrColor :DWord) :Boolean;
+begin
+     Result :=Condition;
+     if Result then AddLineToList(Level, TrueStr, StrColor)
+               else AddLineToList(Level, FalseStr, StrColor);
+
+     if (LogOnFile) and (LogFilename <> '')
+     then RTFileAssert(LogFilename, Condition, TrueStr, FalseStr);
+end;
+
+function RTAssert(TrueStr :ShortString; StrColor :DWord=0) :Boolean;
+begin
+     Result :=RTAssert(0, true, TrueStr, '', StrColor);
+end;
+
+function RTAssert(Condition :Boolean; TrueStr, FalseStr :ShortString; StrColor :DWord=0) :Boolean;
+begin
+     Result :=RTAssert(0, Condition, TrueStr, FalseStr, StrColor);
+end;
+
+function RTAssert(Condition :Boolean; TrueStr :ShortString; StrColor :DWord=0) :Boolean;
+begin
+     if Condition
+     then Result :=RTAssert(0, true, TrueStr, '', StrColor)
+     else Result :=False; 
+end;
+
+function RTFileAssert(Filename :ShortString; Condition :Boolean; TrueStr, FalseStr :ShortString) :Boolean;
+Var
+   ToWrite :PChar;
+   theFile :TFileStream;
+
+begin
+     if FileExists(FileName) then theFile :=TFileStream.Create(FileName, fmOpenWrite)
+                             else theFile :=TFileStream.Create(FileName, fmCreate);
+     try
+        Result :=False;
+        theFile.Seek(0, soFromEnd);
+        if Condition
+        then ToWrite :=PChar(IntToHex(GetCurrentProcessID,8)+' '+
+                             IntToHex(GetCurrentThreadID,8)+' '+
+                             TrueStr+#13#10)
+        else ToWrite :=PChar(IntToHex(GetCurrentProcessID,8)+' '+
+                             IntToHex(GetCurrentThreadID,8)+' '+
+                             FalseStr+#13#10);
+        theFile.Write(ToWrite^, Length(ToWrite));
+        Result :=True;
+     finally
+        theFile.Free;
+     end;
+end;
+
+
+function RTFileEmpty(Filename :ShortString) :Boolean;
+Var
+   theFile :TFileStream;
+
+begin
+     theFile :=TFileStream.Create(FileName, fmCreate);
+     try
+        Result :=False;
+        theFile.Size :=0;
+        Result :=True;
+     finally
+        theFile.Free;
+     end;
+end;
+
+function GetLogFileName :String;
+Var
+   xReg :TMGRegistry;
+
+begin
+     xReg :=TMGRegistry.Create;
+     if xReg.OpenKeyReadOnly(REG_KEY)
+     then begin
+               Result :=xReg.ReadString('', true, REG_LOGFILE);
+               LogOnFile :=xReg.ReadBool(False, REG_LOGONFILE);
+          end
+
+     else begin
+               Result :='';
+               LogOnFile :=False;
+          end;
+     xReg.Free;
+end;
+
+initialization
+   LogFileName :=GetLogFileName;
+
+end.