jcl-checkins-diff Mailing List for JEDI Code Library (Page 28)

jcl-checkins-diff — SVN file check-in notifications with file differences included

You can subscribe to this list here.

2006	Jan	Feb	Mar	Apr (20)	May (48)	Jun (8)	Jul (23)	Aug (41)	Sep (42)	Oct (22)	Nov (17)	Dec (36)
2007	Jan (43)	Feb (42)	Mar (17)	Apr (39)	May (16)	Jun (35)	Jul (37)	Aug (47)	Sep (49)	Oct (9)	Nov (52)	Dec (37)
2008	Jan (48)	Feb (21)	Mar (7)	Apr (2)	May (5)	Jun (17)	Jul (17)	Aug (40)	Sep (58)	Oct (38)	Nov (19)	Dec (32)
2009	Jan (67)	Feb (46)	Mar (54)	Apr (34)	May (37)	Jun (52)	Jul (67)	Aug (72)	Sep (48)	Oct (35)	Nov (27)	Dec (12)
2010	Jan (56)	Feb (46)	Mar (19)	Apr (14)	May (21)	Jun (3)	Jul (13)	Aug (48)	Sep (34)	Oct (51)	Nov (16)	Dec (32)
2011	Jan (36)	Feb (14)	Mar (12)	Apr (3)	May (5)	Jun (24)	Jul (15)	Aug (30)	Sep (21)	Oct (4)	Nov (25)	Dec (23)
2012	Jan (45)	Feb (42)	Mar (19)	Apr (14)	May (13)	Jun (7)	Jul (3)	Aug (46)	Sep (21)	Oct (10)	Nov (2)	Dec
2013	Jan (5)	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov	Dec

Flat | Threaded

<< < 1 .. 26 27 28 29 30 .. 92 > >> (Page 28 of 92)

[Jcl-checkins-diff] SF.net SVN: jcl:[3217] trunk/jcl/source/common/JclCompression.pas

From: <jfu...@us...> - 2010-03-27 17:25:18

Revision: 3217
          http://jcl.svn.sourceforge.net/jcl/?rev=3217&view=rev
Author:   jfudickar
Date:     2010-03-27 17:25:12 +0000 (Sat, 27 Mar 2010)

Log Message:
-----------
- Removed With Statement
- Added utitlity function Create7zFile which encapsulate the logic to create a 7z based archive in one line.
function Create7zFile(SourceFiles: TStrings; const DestinationFile: TFileName; VolumeSize: Int64 = 0; Password: String
    = ''; OnArchiveProgress: TJclCompressionProgressEvent = nil): Boolean; overload;
function Create7zFile(const SourceFile, DestinationFile: TFileName; VolumeSize: Int64 = 0; Password: String = '';
    OnArchiveProgress: TJclCompressionProgressEvent = nil): Boolean; overload;

Modified Paths:
--------------
    trunk/jcl/source/common/JclCompression.pas

Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas	2010-03-27 17:22:27 UTC (rev 3216)
+++ trunk/jcl/source/common/JclCompression.pas	2010-03-27 17:25:12 UTC (rev 3217)
@@ -2340,15 +2340,12 @@
   Assert(FBufferSize > 0);
 
   // Initialize ZLib StreamRecord
-  with ZLibRecord do
-  begin
-    zalloc := nil; // Use build-in memory allocation functionality
-    zfree := nil;
-    next_in := nil;
-    avail_in := 0;
-    next_out := FBuffer;
-    avail_out := FBufferSize;
-  end;
+  ZLibRecord.zalloc := nil; // Use build-in memory allocation functionality
+  ZLibRecord.zfree := nil;
+  ZLibRecord.next_in := nil;
+  ZLibRecord.avail_in := 0;
+  ZLibRecord.next_out := FBuffer;
+  ZLibRecord.avail_out := FBufferSize;
 
   FWindowBits := DEF_WBITS;
   FMemLevel := DEF_MEM_LEVEL;
@@ -2500,15 +2497,12 @@
   LoadZLib;
 
   // Initialize ZLib StreamRecord
-  with ZLibRecord do
-  begin
-    zalloc := nil; // Use build-in memory allocation functionality
-    zfree := nil;
-    next_in := nil;
-    avail_in := 0;
-    next_out := FBuffer;
-    avail_out := FBufferSize;
-  end;
+  ZLibRecord.zalloc := nil; // Use build-in memory allocation functionality
+  ZLibRecord.zfree := nil;
+  ZLibRecord.next_in := nil;
+  ZLibRecord.avail_in := 0;
+  ZLibRecord.next_out := FBuffer;
+  ZLibRecord.avail_out := FBufferSize;
 
   FInflateInitialized := False;
   FWindowBits := WindowBits;
@@ -3933,19 +3927,19 @@
   begin
     CheckSetProperty(ipPackedName);
     if FArchive is TJclCompressArchive then
-      with FArchive as TJclCompressArchive do
+    begin
+      PackedNamesIndex := -1;
+      if (TJclCompressArchive(FArchive).FPackedNames <> nil) and
+         TJclCompressArchive(FArchive).FPackedNames.Find(FPackedName, PackedNamesIndex) then
       begin
-        PackedNamesIndex := -1;
-        if (FPackedNames <> nil) and FPackedNames.Find(FPackedName, PackedNamesIndex) then
-        begin
-          FPackedNames.Delete(PackedNamesIndex);
-          try
-            FPackedNames.Add(Value);
-          except
-            raise EJclCompressionError(Format(LoadResString(@RsCompressionDuplicate), [Value]));
-          end;
+        TJclCompressArchive(FArchive).FPackedNames.Delete(PackedNamesIndex);
+        try
+          TJclCompressArchive(FArchive).FPackedNames.Add(Value);
+        except
+          raise EJclCompressionError(Format(LoadResString(@RsCompressionDuplicate), [Value]));
         end;
       end;
+    end;
     FPackedName := Value;
     Include(FModifiedProperties, ipPackedName);
     Include(FValidProperties, ipPackedName);


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3216] trunk/jcl/source/common/JclFileUtils.pas

From: <jfu...@us...> - 2010-03-27 17:22:33

Revision: 3216
          http://jcl.svn.sourceforge.net/jcl/?rev=3216&view=rev
Author:   jfudickar
Date:     2010-03-27 17:22:27 +0000 (Sat, 27 Mar 2010)

Log Message:
-----------
Now with the removed with statements

Modified Paths:
--------------
    trunk/jcl/source/common/JclFileUtils.pas

Modified: trunk/jcl/source/common/JclFileUtils.pas
===================================================================
--- trunk/jcl/source/common/JclFileUtils.pas	2010-03-27 17:09:54 UTC (rev 3215)
+++ trunk/jcl/source/common/JclFileUtils.pas	2010-03-27 17:22:27 UTC (rev 3216)
@@ -3207,14 +3207,11 @@
   SH: SHFILEOPSTRUCT;
 begin
   ResetMemory(SH, SizeOf(SH));
-  with SH do
-  begin
-    Wnd    := 0;
-    wFunc  := FO_COPY;
-    pFrom  := PChar(PathRemoveSeparator(ExistingDirectoryName) + #0);
-    pTo    := PChar(PathRemoveSeparator(NewDirectoryName) + #0);
-    fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_SILENT;
-  end;
+  SH.Wnd    := 0;
+  SH.wFunc  := FO_COPY;
+  SH.pFrom  := PChar(PathRemoveSeparator(ExistingDirectoryName) + #0);
+  SH.pTo    := PChar(PathRemoveSeparator(NewDirectoryName) + #0);
+  SH.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_SILENT;
   Result := SHFileOperation(SH) = 0;
 end;
 
@@ -3223,14 +3220,11 @@
   SH: SHFILEOPSTRUCT;
 begin
   ResetMemory(SH, SizeOf(SH));
-  with SH do
-  begin
-    Wnd    := 0;
-    wFunc  := FO_MOVE;
-    pFrom  := PChar(PathRemoveSeparator(ExistingDirectoryName) + #0);
-    pTo    := PChar(PathRemoveSeparator(NewDirectoryName) + #0);
-    fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_SILENT;
-  end;
+  SH.Wnd    := 0;
+  SH.wFunc  := FO_MOVE;
+  SH.pFrom  := PChar(PathRemoveSeparator(ExistingDirectoryName) + #0);
+  SH.pTo    := PChar(PathRemoveSeparator(NewDirectoryName) + #0);
+  SH.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_SILENT;
   Result := SHFileOperation(SH) = 0;
 end;
 
@@ -4171,11 +4165,8 @@
 function GetSizeOfFile(const FileInfo: TSearchRec): Int64;
 {$IFDEF MSWINDOWS}
 begin
-  with Int64Rec(Result) do
-  begin
-    Lo := FileInfo.FindData.nFileSizeLow;
-    Hi := FileInfo.FindData.nFileSizeHigh;
-  end;
+  Int64Rec(Result).Lo := FileInfo.FindData.nFileSizeLow;
+  Int64Rec(Result).Hi := FileInfo.FindData.nFileSizeHigh;
 end;
 {$ENDIF MSWINDOWS}
 {$IFDEF UNIX}
@@ -4695,14 +4686,13 @@
 
 function FormatVersionString(const FixedInfo: TVSFixedFileInfo; VersionFormat: TFileVersionFormat): string;
 begin
-  with FixedInfo do
-    case VersionFormat of
-      vfMajorMinor:
-        Result := Format('%u.%u', [HiWord(dwFileVersionMS), LoWord(dwFileVersionMS)]);
-      vfFull:
-        Result := Format('%u.%u.%u.%u', [HiWord(dwFileVersionMS), LoWord(dwFileVersionMS),
-          HiWord(dwFileVersionLS), LoWord(dwFileVersionLS)]);
-    end;
+  case VersionFormat of
+    vfMajorMinor:
+      Result := Format('%u.%u', [HiWord(FixedInfo.dwFileVersionMS), LoWord(FixedInfo.dwFileVersionMS)]);
+    vfFull:
+      Result := Format('%u.%u.%u.%u', [HiWord(FixedInfo.dwFileVersionMS), LoWord(FixedInfo.dwFileVersionMS),
+        HiWord(FixedInfo.dwFileVersionLS), LoWord(FixedInfo.dwFileVersionLS)]);
+  end;
 end;
 
 // Version Info extracting
@@ -5078,17 +5068,16 @@
 
 function TJclFileVersionInfo.GetBinFileVersion: string;
 begin
-  with FFixedInfo^ do
-    Result := Format('%u.%u.%u.%u', [HiWord(dwFileVersionMS),
-      LoWord(dwFileVersionMS), HiWord(dwFileVersionLS), LoWord(dwFileVersionLS)]);
+  Result := Format('%u.%u.%u.%u', [HiWord(FFixedInfo^.dwFileVersionMS),
+    LoWord(FFixedInfo^.dwFileVersionMS), HiWord(FFixedInfo^.dwFileVersionLS),
+    LoWord(FFixedInfo^.dwFileVersionLS)]);
 end;
 
 function TJclFileVersionInfo.GetBinProductVersion: string;
 begin
-  with FFixedInfo^ do
-    Result := Format('%u.%u.%u.%u', [HiWord(dwProductVersionMS),
-      LoWord(dwProductVersionMS), HiWord(dwProductVersionLS),
-      LoWord(dwProductVersionLS)]);
+  Result := Format('%u.%u.%u.%u', [HiWord(FFixedInfo^.dwProductVersionMS),
+    LoWord(FFixedInfo^.dwProductVersionMS), HiWord(FFixedInfo^.dwProductVersionLS),
+    LoWord(FFixedInfo^.dwProductVersionLS)]);
 end;
 
 function TJclFileVersionInfo.GetCustomFieldValue(const FieldName: string): string;
@@ -6498,11 +6487,10 @@
   I: Integer;
 begin
   for I := 0 to FTasks.Count - 1 do
-    with TEnumFileThread(FTasks[I]) do
-    begin
-      FNotifyOnTermination := not Silently;
-      Terminate;
-    end;
+  begin
+    TEnumFileThread(FTasks[I]).FNotifyOnTermination := not Silently;
+    TEnumFileThread(FTasks[I]).Terminate;
+  end;
 end;
 
 procedure TJclFileEnumerator.TaskTerminated(Sender: TObject);
@@ -6510,8 +6498,7 @@
   FTasks.Remove(Sender);
   try
     if Assigned(FOnTerminateTask) then
-      with TEnumFileThread(Sender) do
-        FOnTerminateTask(ID, Terminated);
+      FOnTerminateTask(TEnumFileThread(Sender).ID, TEnumFileThread(Sender).Terminated);
   finally
     if FRefCount > 0 then
       _Release;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3215] trunk/jcl/source/common/JclCompression.pas

From: <jfu...@us...> - 2010-03-27 17:10:01

Revision: 3215
          http://jcl.svn.sourceforge.net/jcl/?rev=3215&view=rev
Author:   jfudickar
Date:     2010-03-27 17:09:54 +0000 (Sat, 27 Mar 2010)

Log Message:
-----------
Added utitlity function Create7zFile which encapsulate the logic to create a 7z based archive in one line.
function Create7zFile(SourceFiles: TStrings; const DestinationFile: TFileName; VolumeSize: Int64 = 0; Password: String
    = ''; OnArchiveProgress: TJclCompressionProgressEvent = nil): Boolean; overload;
function Create7zFile(const SourceFile, DestinationFile: TFileName; VolumeSize: Int64 = 0; Password: String = '';
    OnArchiveProgress: TJclCompressionProgressEvent = nil): Boolean; overload;

Modified Paths:
--------------
    trunk/jcl/source/common/JclCompression.pas

Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas	2010-03-27 17:07:13 UTC (rev 3214)
+++ trunk/jcl/source/common/JclCompression.pas	2010-03-27 17:09:54 UTC (rev 3215)
@@ -2059,6 +2059,12 @@
 procedure GetSevenzipArchiveCompressionProperties(AJclArchive: IInterface; ASevenzipArchive: IInterface);
 procedure SetSevenzipArchiveCompressionProperties(AJclArchive: IInterface; ASevenzipArchive: IInterface);
 
+
+function Create7zFile(SourceFiles: TStrings; const DestinationFile: TFileName; VolumeSize: Int64 = 0; Password: String
+    = ''; OnArchiveProgress: TJclCompressionProgressEvent = nil): Boolean; overload;
+function Create7zFile(const SourceFile, DestinationFile: TFileName; VolumeSize: Int64 = 0; Password: String = '';
+    OnArchiveProgress: TJclCompressionProgressEvent = nil): Boolean; overload;
+
 {$ENDIF MSWINDOWS}
 
 {$IFDEF UNITVERSIONING}
@@ -5759,6 +5765,69 @@
   end;
 end;
 
+function Create7zFile(SourceFiles: TStrings; const DestinationFile: TFileName; VolumeSize: Int64 = 0; Password: String
+    = ''; OnArchiveProgress: TJclCompressionProgressEvent = nil): Boolean;
+var
+  ArchiveFileName: string;
+  SourceFile : String;
+  AFormat: TJclUpdateArchiveClass;
+  Archive : TJclCompressionArchive;
+  i: Integer;
+  InnerList : tStringList;
+  j: Integer;
+begin
+  Result := False;
+  ArchiveFileName := DestinationFile;
+
+  AFormat := GetArchiveFormats.FindUpdateFormat(ArchiveFileName);
+
+  if AFormat <> nil then
+  begin
+
+    if VolumeSize <> 0 then
+      ArchiveFileName := ArchiveFileName + '.%.3d';
+
+    Archive := AFormat.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0);
+    try
+      Archive.Password := Password;
+      Archive.OnProgress := OnArchiveProgress;
+
+      InnerList := tStringList.Create;
+      try
+        for i := 0 to SourceFiles.Count - 1 do
+        begin
+          InnerList.Clear;
+          BuildFileList(SourceFiles[i], faAnyFile, InnerList, True);
+          for j := 0 to InnerList.Count - 1 do
+          begin
+            SourceFile:=InnerList[j];
+            (Archive as TJclCompressArchive).AddFile(ExtractFileName(SourceFile), SourceFile);
+            Result := True;
+          end;
+        end;
+      finally
+        InnerList.Free;
+      end;
+      (Archive as TJclCompressArchive).Compress;
+    finally
+      Archive.Free;
+    end;
+  end;
+end;
+
+function Create7zFile(const SourceFile, DestinationFile: TFileName; VolumeSize: Int64 = 0; Password: String = '';
+    OnArchiveProgress: TJclCompressionProgressEvent = nil): Boolean;
+var SourceFiles : TStringList;
+begin
+  SourceFiles := TStringList.Create;
+  try
+    SourceFiles.Add(SourceFile);
+    Result := Create7zFile(SourceFiles, DestinationFile, VolumeSize, Password, OnArchiveProgress);
+  finally
+    SourceFiles.Free;
+  end;
+end;
+
 //=== { TJclSevenzipOutputCallback } =========================================
 
 constructor TJclSevenzipUpdateCallback.Create(


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3214] trunk/jcl/source/common/JclFileUtils.pas

From: <jfu...@us...> - 2010-03-27 17:07:19

Revision: 3214
          http://jcl.svn.sourceforge.net/jcl/?rev=3214&view=rev
Author:   jfudickar
Date:     2010-03-27 17:07:13 +0000 (Sat, 27 Mar 2010)

Log Message:
-----------
- Removed With Statements
- Added parameter "IncludeDirectoryName: Boolean = False" to BuildFileList 

Modified Paths:
--------------
    trunk/jcl/source/common/JclFileUtils.pas

Modified: trunk/jcl/source/common/JclFileUtils.pas
===================================================================
--- trunk/jcl/source/common/JclFileUtils.pas	2010-03-22 18:46:17 UTC (rev 3213)
+++ trunk/jcl/source/common/JclFileUtils.pas	2010-03-27 17:07:13 UTC (rev 3214)
@@ -172,7 +172,8 @@
   TFileHandlerEx = procedure (const Directory: string; const FileInfo: TSearchRec) of object;
   TFileInfoHandlerEx = procedure (const FileInfo: TSearchRec) of object;
 
-function BuildFileList(const Path: string; const Attr: Integer; const List: TStrings): Boolean;
+function BuildFileList(const Path: string; const Attr: Integer; const List: TStrings; IncludeDirectoryName: Boolean =
+    False): Boolean;
 function AdvBuildFileList(const Path: string; const Attr: Integer; const Files: TStrings;
   const AttributeMatch: TJclAttributeMatch = amSuperSetOf; const Options: TFileListOptions = [];
   const SubfoldersMask: string = ''; const FileMatchFunc: TFileMatchFunc = nil): Boolean;
@@ -3099,8 +3100,8 @@
    FileMask Seperator = ';'
  *}
 
-function BuildFileList(const Path: string; const Attr: Integer;
-  const List: TStrings): Boolean;
+function BuildFileList(const Path: string; const Attr: Integer; const List: TStrings; IncludeDirectoryName: Boolean =
+    False): Boolean;
 var
   SearchRec: TSearchRec;
   IndexMask: Integer;
@@ -3139,7 +3140,10 @@
             and ((SearchRec.Attr and Attr) = (SearchRec.Attr and faAnyFile))
             and IsFileNameMatch(SearchRec.Name, MaskList.Strings[IndexMask]) then
         begin
-          List.Add(SearchRec.Name);
+          if IncludeDirectoryName then
+            List.Add(Directory+SearchRec.Name)
+          else
+            List.Add(SearchRec.Name);
           Break;
         end;
 


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3213] trunk/jcl/source

From: <ou...@us...> - 2010-03-22 18:46:24

Revision: 3213
          http://jcl.svn.sourceforge.net/jcl/?rev=3213&view=rev
Author:   outchy
Date:     2010-03-22 18:46:17 +0000 (Mon, 22 Mar 2010)

Log Message:
-----------
Mantis 5111: GetTotalPhysicalMemory returns wrong values.

Modified Paths:
--------------
    trunk/jcl/source/common/JclSysInfo.pas
    trunk/jcl/source/prototypes/win32api/WinBase.imp
    trunk/jcl/source/prototypes/win32api/WinBase.int
    trunk/jcl/source/windows/JclWin32.pas

Modified: trunk/jcl/source/common/JclSysInfo.pas
===================================================================
--- trunk/jcl/source/common/JclSysInfo.pas	2010-03-22 18:08:05 UTC (rev 3212)
+++ trunk/jcl/source/common/JclSysInfo.pas	2010-03-22 18:46:17 UTC (rev 3213)
@@ -1266,15 +1266,15 @@
 function GetMinAppAddress: TJclAddr;
 {$ENDIF MSWINDOWS}
 function GetMemoryLoad: Byte;
-function GetSwapFileSize: Cardinal;
+function GetSwapFileSize: Int64;
 function GetSwapFileUsage: Byte;
-function GetTotalPhysicalMemory: Cardinal;
-function GetFreePhysicalMemory: Cardinal;
+function GetTotalPhysicalMemory: Int64;
+function GetFreePhysicalMemory: Int64;
 {$IFDEF MSWINDOWS}
-function GetTotalPageFileMemory: Cardinal;
-function GetFreePageFileMemory: Cardinal;
-function GetTotalVirtualMemory: Cardinal;
-function GetFreeVirtualMemory: Cardinal;
+function GetTotalPageFileMemory: Int64;
+function GetFreePageFileMemory: Int64;
+function GetTotalVirtualMemory: Int64;
+function GetFreeVirtualMemory: Int64;
 {$ENDIF MSWINDOWS}
 
 // Alloc granularity
@@ -5179,16 +5179,17 @@
 {$ENDIF UNIX}
 {$IFDEF MSWINDOWS}
 var
-  MemoryStatus: TMemoryStatus;
+  MemoryStatusEx: TMemoryStatusEx;
 begin
-  ResetMemory(MemoryStatus, SizeOf(MemoryStatus));
-  MemoryStatus.dwLength := SizeOf(MemoryStatus);
-  GlobalMemoryStatus(MemoryStatus);
-  Result := MemoryStatus.dwMemoryLoad;
+  ResetMemory(MemoryStatusEx, SizeOf(MemoryStatusEx));
+  MemoryStatusEx.dwLength := SizeOf(MemoryStatusEx);
+  if not GlobalMemoryStatusEx(MemoryStatusEx) then
+    RaiseLastOSError;
+  Result := MemoryStatusEx.dwMemoryLoad;
 end;
 {$ENDIF MSWINDOWS}
 
-function GetSwapFileSize: Cardinal;
+function GetSwapFileSize: Int64;
 {$IFDEF UNIX}
 var
   SystemInf: TSysInfo;
@@ -5203,12 +5204,13 @@
 {$ENDIF UNIX}
 {$IFDEF MSWINDOWS}
 var
-  MemoryStatus: TMemoryStatus;
+  MemoryStatusEx: TMemoryStatusEx;
 begin
-  ResetMemory(MemoryStatus, SizeOf(MemoryStatus));
-  MemoryStatus.dwLength := SizeOf(MemoryStatus);
-  GlobalMemoryStatus(MemoryStatus);
-  Result := TJclAddr(MemoryStatus.dwTotalPageFile) - TJclAddr(MemoryStatus.dwAvailPageFile);
+  ResetMemory(MemoryStatusEx, SizeOf(MemoryStatusEx));
+  MemoryStatusEx.dwLength := SizeOf(MemoryStatusEx);
+  if not GlobalMemoryStatusEx(MemoryStatusEx) then
+    RaiseLastOSError;
+  Result := MemoryStatusEx.ullTotalPageFile - MemoryStatusEx.ullAvailPageFile;
 end;
 {$ENDIF MSWINDOWS}
 
@@ -5228,20 +5230,20 @@
 {$ENDIF UNIX}
 {$IFDEF MSWINDOWS}
 var
-  MemoryStatus: TMemoryStatus;
+  MemoryStatusEx: TMemoryStatusEx;
 begin
-  ResetMemory(MemoryStatus, SizeOf(MemoryStatus));
-  MemoryStatus.dwLength := SizeOf(MemoryStatus);
-  GlobalMemoryStatus(MemoryStatus);
-  with MemoryStatus do
-    if dwTotalPageFile > 0 then
-      Result := 100 - Trunc(dwAvailPageFile / dwTotalPageFile * 100)
+  ResetMemory(MemoryStatusEx, SizeOf(MemoryStatusEx));
+  MemoryStatusEx.dwLength := SizeOf(MemoryStatusEx);
+  if not GlobalMemoryStatusEx(MemoryStatusEx) then
+    RaiseLastOSError;
+  if MemoryStatusEx.ullTotalPageFile > 0 then
+      Result := 100 - Trunc(MemoryStatusEx.ullAvailPageFile / MemoryStatusEx.ullTotalPageFile * 100)
     else
       Result := 0;
 end;
 {$ENDIF MSWINDOWS}
 
-function GetTotalPhysicalMemory: Cardinal;
+function GetTotalPhysicalMemory: Int64;
 {$IFDEF UNIX}
 var
   SystemInf: TSysInfo;
@@ -5256,16 +5258,17 @@
 {$ENDIF UNIX}
 {$IFDEF MSWINDOWS}
 var
-  MemoryStatus: TMemoryStatus;
+  MemoryStatusEx: TMemoryStatusEx;
 begin
-  ResetMemory(MemoryStatus, SizeOf(MemoryStatus));
-  MemoryStatus.dwLength := SizeOf(MemoryStatus);
-  GlobalMemoryStatus(MemoryStatus);
-  Result := MemoryStatus.dwTotalPhys;
+  ResetMemory(MemoryStatusEx, SizeOf(MemoryStatusEx));
+  MemoryStatusEx.dwLength := SizeOf(MemoryStatusEx);
+  if not GlobalMemoryStatusEx(MemoryStatusEx) then
+    RaiseLastOSError;
+  Result := MemoryStatusEx.ullTotalPhys;
 end;
 {$ENDIF MSWINDOWS}
 
-function GetFreePhysicalMemory: Cardinal;
+function GetFreePhysicalMemory: Int64;
 {$IFDEF UNIX}
 var
   SystemInf: TSysInfo;
@@ -5280,52 +5283,57 @@
 {$ENDIF UNIX}
 {$IFDEF MSWINDOWS}
 var
-  MemoryStatus: TMemoryStatus;
+  MemoryStatusEx: TMemoryStatusEx;
 begin
-  ResetMemory(MemoryStatus, SizeOf(MemoryStatus));
-  MemoryStatus.dwLength := SizeOf(MemoryStatus);
-  GlobalMemoryStatus(MemoryStatus);
-  Result := MemoryStatus.dwAvailPhys;
+  ResetMemory(MemoryStatusEx, SizeOf(MemoryStatusEx));
+  MemoryStatusEx.dwLength := SizeOf(MemoryStatusEx);
+  if not GlobalMemoryStatusEx(MemoryStatusEx) then
+    RaiseLastOSError;
+  Result := MemoryStatusEx.ullAvailPhys;
 end;
 
-function GetTotalPageFileMemory: Cardinal;
+function GetTotalPageFileMemory: Int64;
 var
-  MemoryStatus: TMemoryStatus;
+  MemoryStatusEx: TMemoryStatusEx;
 begin
-  ResetMemory(MemoryStatus, SizeOf(MemoryStatus));
-  MemoryStatus.dwLength := SizeOf(MemoryStatus);
-  GlobalMemoryStatus(MemoryStatus);
-  Result := MemoryStatus.dwTotalPageFile;
+  ResetMemory(MemoryStatusEx, SizeOf(MemoryStatusEx));
+  MemoryStatusEx.dwLength := SizeOf(MemoryStatusEx);
+  if not GlobalMemoryStatusEx(MemoryStatusEx) then
+    RaiseLastOSError;
+  Result := MemoryStatusEx.ullTotalPageFile;
 end;
 
-function GetFreePageFileMemory: Cardinal;
+function GetFreePageFileMemory: Int64;
 var
-  MemoryStatus: TMemoryStatus;
+  MemoryStatusEx: TMemoryStatusEx;
 begin
-  ResetMemory(MemoryStatus, SizeOf(MemoryStatus));
-  MemoryStatus.dwLength := SizeOf(MemoryStatus);
-  GlobalMemoryStatus(MemoryStatus);
-  Result := MemoryStatus.dwAvailPageFile;
+  ResetMemory(MemoryStatusEx, SizeOf(MemoryStatusEx));
+  MemoryStatusEx.dwLength := SizeOf(MemoryStatusEx);
+  if not GlobalMemoryStatusEx(MemoryStatusEx) then
+    RaiseLastOSError;
+  Result := MemoryStatusEx.ullAvailPageFile;
 end;
 
-function GetTotalVirtualMemory: Cardinal;
+function GetTotalVirtualMemory: Int64;
 var
-  MemoryStatus: TMemoryStatus;
+  MemoryStatusEx: TMemoryStatusEx;
 begin
-  ResetMemory(MemoryStatus, SizeOf(MemoryStatus));
-  MemoryStatus.dwLength := SizeOf(MemoryStatus);
-  GlobalMemoryStatus(MemoryStatus);
-  Result := MemoryStatus.dwTotalVirtual;
+  ResetMemory(MemoryStatusEx, SizeOf(MemoryStatusEx));
+  MemoryStatusEx.dwLength := SizeOf(MemoryStatusEx);
+  if not GlobalMemoryStatusEx(MemoryStatusEx) then
+    RaiseLastOSError;
+  Result := MemoryStatusEx.ullTotalVirtual;
 end;
 
-function GetFreeVirtualMemory: Cardinal;
+function GetFreeVirtualMemory: Int64;
 var
-  MemoryStatus: TMemoryStatus;
+  MemoryStatusEx: TMemoryStatusEx;
 begin
-  ResetMemory(MemoryStatus, SizeOf(MemoryStatus));
-  MemoryStatus.dwLength := SizeOf(MemoryStatus);
-  GlobalMemoryStatus(MemoryStatus);
-  Result := MemoryStatus.dwAvailVirtual;
+  ResetMemory(MemoryStatusEx, SizeOf(MemoryStatusEx));
+  MemoryStatusEx.dwLength := SizeOf(MemoryStatusEx);
+  if not GlobalMemoryStatusEx(MemoryStatusEx) then
+    RaiseLastOSError;
+  Result := MemoryStatusEx.ullAvailVirtual;
 end;
 
 //=== Keyboard Information ===================================================

Modified: trunk/jcl/source/prototypes/win32api/WinBase.imp
===================================================================
--- trunk/jcl/source/prototypes/win32api/WinBase.imp	2010-03-22 18:08:05 UTC (rev 3212)
+++ trunk/jcl/source/prototypes/win32api/WinBase.imp	2010-03-22 18:46:17 UTC (rev 3213)
@@ -1,6 +1,18 @@
 {$IFDEF MSWINDOWS}
 
 type
+  TGlobalMemoryStatusEx = function (out lpBuffer: TMemoryStatusEx): BOOL; stdcall;
+
+var
+  _GlobalMemoryStatusEx: TGlobalMemoryStatusEx = nil;
+
+function GlobalMemoryStatusEx(out lpBuffer: TMemoryStatusEx): BOOL; stdcall;
+begin
+  GetProcedureAddress(Pointer(@_GlobalMemoryStatusEx), kernel32, 'GlobalMemoryStatusEx');
+  Result := _GlobalMemoryStatusEx(lpBuffer);
+end;
+
+type
   TBackupSeek = function (hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD;
     out lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD;
     var lpContext: Pointer): BOOL; stdcall;

Modified: trunk/jcl/source/prototypes/win32api/WinBase.int
===================================================================
--- trunk/jcl/source/prototypes/win32api/WinBase.int	2010-03-22 18:08:05 UTC (rev 3212)
+++ trunk/jcl/source/prototypes/win32api/WinBase.int	2010-03-22 18:46:17 UTC (rev 3213)
@@ -29,6 +29,30 @@
   FILE_FLAG_FIRST_PIPE_INSTANCE = $00080000;
   {$EXTERNALSYM FILE_FLAG_FIRST_PIPE_INSTANCE}
 
+// line 2727
+type
+  _MEMORYSTATUSEX = packed record
+    dwLength: DWORD;
+    dwMemoryLoad: DWORD;
+    ullTotalPhys: Int64;
+    ullAvailPhys: Int64;
+    ullTotalPageFile: Int64;
+    ullAvailPageFile: Int64;
+    ullTotalVirtual: Int64;
+    ullAvailVirtual: Int64;
+    ullAvailExtendedVirtual: Int64;
+  end;
+  {$EXTERNALSYM _MEMORYSTATUSEX}
+
+  MEMORYSTATUSEX = _MEMORYSTATUSEX;
+  {$EXTERNALSYM MEMORYSTATUSEX}
+  LPMEMORYSTATUSEX = ^_MEMORYSTATUSEX;
+  {$EXTERNALSYM LPMEMORYSTATUSEX}
+
+  TMemoryStatusEx = _MEMORYSTATUSEX;
+
+function GlobalMemoryStatusEx(out lpBuffer: TMemoryStatusEx): BOOL; stdcall;
+
 // line 3189
   
 {$IFDEF MSWINDOWS}

Modified: trunk/jcl/source/windows/JclWin32.pas
===================================================================
--- trunk/jcl/source/windows/JclWin32.pas	2010-03-22 18:08:05 UTC (rev 3212)
+++ trunk/jcl/source/windows/JclWin32.pas	2010-03-22 18:46:17 UTC (rev 3213)
@@ -2946,10 +2946,33 @@
   FILE_FLAG_FIRST_PIPE_INSTANCE = $00080000;
   {$EXTERNALSYM FILE_FLAG_FIRST_PIPE_INSTANCE}
 
+// line 2727
+type
+  _MEMORYSTATUSEX = packed record
+    dwLength: DWORD;
+    dwMemoryLoad: DWORD;
+    ullTotalPhys: Int64;
+    ullAvailPhys: Int64;
+    ullTotalPageFile: Int64;
+    ullAvailPageFile: Int64;
+    ullTotalVirtual: Int64;
+    ullAvailVirtual: Int64;
+    ullAvailExtendedVirtual: Int64;
+  end;
+  {$EXTERNALSYM _MEMORYSTATUSEX}
+
+  MEMORYSTATUSEX = _MEMORYSTATUSEX;
+  {$EXTERNALSYM MEMORYSTATUSEX}
+  LPMEMORYSTATUSEX = ^_MEMORYSTATUSEX;
+  {$EXTERNALSYM LPMEMORYSTATUSEX}
+
+  TMemoryStatusEx = _MEMORYSTATUSEX;
+
+function GlobalMemoryStatusEx(out lpBuffer: TMemoryStatusEx): BOOL; stdcall;
+
 // line 3189
   
 
-
 function BackupSeek(hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD;
   out lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD;
   var lpContext: Pointer): BOOL; stdcall;
@@ -3073,18 +3096,15 @@
 {$EXTERNALSYM SetExtendedFeaturesMask}
 
 
-
 // From JwaAclApi
 
 // line 185
 
-
 function SetNamedSecurityInfoW(pObjectName: LPWSTR; ObjectType: SE_OBJECT_TYPE;
   SecurityInfo: SECURITY_INFORMATION; psidOwner, psidGroup: PSID;
   pDacl, pSacl: PACL): DWORD; stdcall;
 {$EXTERNALSYM SetNamedSecurityInfoW}
 
-
 const
   IMAGE_SEPARATION = (64*1024);
   {$EXTERNALSYM IMAGE_SEPARATION}
@@ -3115,7 +3135,6 @@
 // line 152
 
 
-
 function ReBaseImage(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL;
   fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG;
   var OldImageSize: ULONG; var OldImageBase: ULONG_PTR; var NewImageSize: ULONG;
@@ -3170,7 +3189,6 @@
 {$EXTERNALSYM ImageRvaToVa}
 
 
-
 // line 461
 
 //
@@ -4559,6 +4577,7 @@
 //
 
 
+
 function NetUserAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall;
 {$EXTERNALSYM NetUserAdd}
 
@@ -4593,6 +4612,7 @@
 {$EXTERNALSYM NetUserChangePassword}
 
 
+
 //
 //  Data Structures - User
 //
@@ -4803,6 +4823,7 @@
 //
 
 
+
 function NetGroupAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall;
 {$EXTERNALSYM NetGroupAdd}
 
@@ -4832,6 +4853,7 @@
 {$EXTERNALSYM NetGroupSetUsers}
 
 
+
 //
 //  Data Structures - Group
 //
@@ -4875,6 +4897,7 @@
 //
 
 
+
 function NetLocalGroupAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall;
 {$EXTERNALSYM NetLocalGroupAdd}
 
@@ -4910,6 +4933,7 @@
 {$EXTERNALSYM NetLocalGroupDelMembers}
 
 
+
 //
 //  Data Structures - LocalGroup
 //
@@ -5017,9 +5041,11 @@
   PLocalGroupMembersInfo3 = PLOCALGROUP_MEMBERS_INFO_3;
   {$ENDIF ~FPC}
 
+
 function NetApiBufferFree(Buffer: Pointer): NET_API_STATUS; stdcall;
 {$EXTERNALSYM NetApiBufferFree}
 
+
 (****************************************************************
  *                                                              *
  *              Data structure templates                        *
@@ -5452,9 +5478,11 @@
  * Usage: result = Netbios( pncb );                             *
  ****************************************************************)
 
+
 function Netbios(pncb: PNCB): UCHAR; stdcall;
 {$EXTERNALSYM Netbios}
 
+
 type
   PRasDialDlg = ^TRasDialDlg;
   tagRASDIALDLG = packed record
@@ -6623,6 +6651,7 @@
 // line 1635
 
 
+
 function GetCalendarInfoA(Locale: LCID; Calendar: CALID; CalType: CALTYPE;
   lpCalData: LPSTR; cchData: Integer; lpValue: LPDWORD): Integer; stdcall;
 {$EXTERNALSYM GetCalendarInfoA}
@@ -6637,6 +6666,7 @@
 {$EXTERNALSYM EnumCalendarInfoExW}
 
 
+
 {$IFNDEF FPC}
 type
   MAKEINTRESOURCEA = LPSTR;
@@ -8222,6 +8252,18 @@
 
 
 type
+  TGlobalMemoryStatusEx = function (out lpBuffer: TMemoryStatusEx): BOOL; stdcall;
+
+var
+  _GlobalMemoryStatusEx: TGlobalMemoryStatusEx = nil;
+
+function GlobalMemoryStatusEx(out lpBuffer: TMemoryStatusEx): BOOL; stdcall;
+begin
+  GetProcedureAddress(Pointer(@_GlobalMemoryStatusEx), kernel32, 'GlobalMemoryStatusEx');
+  Result := _GlobalMemoryStatusEx(lpBuffer);
+end;
+
+type
   TBackupSeek = function (hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD;
     out lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD;
     var lpContext: Pointer): BOOL; stdcall;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3212] trunk/jcl/source/common/JclCompression.pas

From: <ou...@us...> - 2010-03-22 18:08:18

Revision: 3212
          http://jcl.svn.sourceforge.net/jcl/?rev=3212&view=rev
Author:   outchy
Date:     2010-03-22 18:08:05 +0000 (Mon, 22 Mar 2010)

Log Message:
-----------
Less Unicode specific code.

Modified Paths:
--------------
    trunk/jcl/source/common/JclCompression.pas

Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas	2010-03-22 17:55:47 UTC (rev 3211)
+++ trunk/jcl/source/common/JclCompression.pas	2010-03-22 18:08:05 UTC (rev 3212)
@@ -63,9 +63,7 @@
   {$IFDEF HAS_UNIT_LIBC}
   Libc,
   {$ENDIF HAS_UNIT_LIBC}
-  {$IFNDEF SUPPORTS_UNICODE}
   JclWideStrings,
-  {$ENDIF ~SUPPORTS_UNICODE}
   SysUtils, Classes, Contnrs,
   zlibh, bzip2,
   JclBase, JclStreams;
@@ -938,7 +936,7 @@
     procedure InternalAddDirectory(const Directory: string);
   protected
     FCompressing: Boolean;
-    FPackedNames: {$IFDEF SUPPORTS_UNICODE}TStringList{$ELSE}TWStringList{$ENDIF};
+    FPackedNames: TJclWideStringList;
     procedure CheckNotCompressing;
     function AddFileCheckDuplicate(NewItem: TJclCompressionItem): Integer;
   public
@@ -4708,7 +4706,7 @@
   begin
     if FPackedNames = nil then
     begin
-      FPackedNames := {$IFDEF SUPPORTS_UNICODE}TStringList{$ELSE}TWStringList{$ENDIF}.Create;
+      FPackedNames := TJclWideStringList.Create;
       FPackedNames.Sorted := True;
       {$IFDEF UNIX}
       FPackedNames.CaseSensitive := True;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3211] trunk/jcl/source/common/JclCompression.pas

From: <ou...@us...> - 2010-03-22 17:56:16

Revision: 3211
          http://jcl.svn.sourceforge.net/jcl/?rev=3211&view=rev
Author:   outchy
Date:     2010-03-22 17:55:47 +0000 (Mon, 22 Mar 2010)

Log Message:
-----------
Mantis 5192: Zip decompression does not create zero-length files.

Modified Paths:
--------------
    trunk/jcl/source/common/JclCompression.pas

Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas	2010-03-22 17:52:00 UTC (rev 3210)
+++ trunk/jcl/source/common/JclCompression.pas	2010-03-22 17:55:47 UTC (rev 3211)
@@ -3984,7 +3984,7 @@
   Result := FFileName <> '';
   if Result then
   begin
-    FileHandle := CreateFile(PChar(FFileName), FILE_WRITE_ATTRIBUTES, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
+    FileHandle := CreateFile(PChar(FFileName), FILE_WRITE_ATTRIBUTES, FILE_SHARE_READ, nil, OPEN_ALWAYS, 0, 0);
     try
       // creation time should be the oldest
       if ipCreationTime in FValidProperties then


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3210] trunk/jcl/source/common/JclCompression.pas

From: <ou...@us...> - 2010-03-22 17:52:36

Revision: 3210
          http://jcl.svn.sourceforge.net/jcl/?rev=3210&view=rev
Author:   outchy
Date:     2010-03-22 17:52:00 +0000 (Mon, 22 Mar 2010)

Log Message:
-----------
Mantis 5196: Memory leak in TJclCompressArchive.
The FPackedNames object is never freed. 

Modified Paths:
--------------
    trunk/jcl/source/common/JclCompression.pas

Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas	2010-03-19 14:54:23 UTC (rev 3209)
+++ trunk/jcl/source/common/JclCompression.pas	2010-03-22 17:52:00 UTC (rev 3210)
@@ -945,6 +945,8 @@
     class function VolumeAccess: TJclStreamAccess; override;
     class function ItemAccess: TJclStreamAccess; override;
 
+    destructor Destroy; override;
+    
     function AddDirectory(const PackedName: WideString;
       const DirName: string = ''; RecurseIntoDir: Boolean = False;
       AddFilesInDir: Boolean = False): Integer; overload; virtual;
@@ -4601,6 +4603,12 @@
 
 //=== { TJclCompressArchive } ================================================
 
+destructor TJclCompressArchive.Destroy;
+begin
+  FPackedNames.Free;
+  inherited Destroy;
+end;
+
 function TJclCompressArchive.AddDirectory(const PackedName: WideString;
   const DirName: string; RecurseIntoDir: Boolean; AddFilesInDir: Boolean): Integer;
 var


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3209] trunk/website/delphi-jedi/page21.html

From: <ob...@us...> - 2010-03-19 14:54:31

Revision: 3209
          http://jcl.svn.sourceforge.net/jcl/?rev=3209&view=rev
Author:   obones
Date:     2010-03-19 14:54:23 +0000 (Fri, 19 Mar 2010)

Log Message:
-----------
Move over to news.delphi-jedi.org

Modified Paths:
--------------
    trunk/website/delphi-jedi/page21.html

Modified: trunk/website/delphi-jedi/page21.html
===================================================================
--- trunk/website/delphi-jedi/page21.html	2010-03-07 08:55:57 UTC (rev 3208)
+++ trunk/website/delphi-jedi/page21.html	2010-03-19 14:54:23 UTC (rev 3209)
@@ -62,11 +62,11 @@
        <td>Purpose</td>
 </tr>
 <tr>
-       <td>news://forums.talkto.net/jedi.jcl</td>
+       <td>news://news.delphi-jedi.org/jedi.jcl</td>
        <td>for JCL users and developers</td>
 </tr>
 <tr>
-       <td>news://forums.talkto.net/jedi.general</td>
+       <td>news://news.delphi-jedi.org/jedi.general</td>
        <td>general JEDI topics</td>
 </tr>
 </table>


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3208] trunk/jcl/experts/debug/converter/JclDebugIdeImpl. pas

From: <ah...@us...> - 2010-03-07 08:56:03

Revision: 3208
          http://jcl.svn.sourceforge.net/jcl/?rev=3208&view=rev
Author:   ahuser
Date:     2010-03-07 08:55:57 +0000 (Sun, 07 Mar 2010)

Log Message:
-----------
Fixed compile error

Modified Paths:
--------------
    trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas

Modified: trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas	2010-03-04 21:22:15 UTC (rev 3207)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas	2010-03-07 08:55:57 UTC (rev 3208)
@@ -1532,7 +1532,7 @@
   try
     try
       if not IsCodeInsight then
-        FDebugExtension.AfterCompile(Succeeded, FCurrentProject);
+        FDebugExtension.AfterCompile(FCurrentProject, Succeeded);
     finally
       FCurrentProject := nil;
     end;
@@ -1547,7 +1547,7 @@
 begin
   try
     if not IsCodeInsight then
-      FDebugExtension.AfterCompile(Succeeded, Project);
+      FDebugExtension.AfterCompile(Project, Succeeded);
   except
     on ExceptionObj: Exception do
       JclExpertShowExceptionDialog(ExceptionObj);


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3207] trunk/jcl/experts/debug/converter/JclDebugIdeImpl. pas

From: <ah...@us...> - 2010-03-04 21:22:22

Revision: 3207
          http://jcl.svn.sourceforge.net/jcl/?rev=3207&view=rev
Author:   ahuser
Date:     2010-03-04 21:22:15 +0000 (Thu, 04 Mar 2010)

Log Message:
-----------
Changed order of AfterCompile parameters to be in sync with IOTAIDENotifier80.AfterCompile

Modified Paths:
--------------
    trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas

Modified: trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas	2010-03-04 21:17:07 UTC (rev 3206)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas	2010-03-04 21:22:15 UTC (rev 3207)
@@ -115,7 +115,7 @@
     function GetProjectActions(const AProject: IOTAProject): TDebugExpertActions;
   public
     constructor Create; reintroduce;
-    procedure AfterCompile(Succeeded: Boolean; const Project: IOTAProject);
+    procedure AfterCompile(const Project: IOTAProject; Succeeded: Boolean);
     procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
     procedure RegisterCommands; override;
     procedure UnregisterCommands; override;
@@ -313,7 +313,7 @@
   AddPageFunc(FConfigFrame, LoadResString(@RsDebugConfigPageCaption), Self);
 end;
 
-procedure TJclDebugExtension.AfterCompile(Succeeded: Boolean; const Project: IOTAProject);
+procedure TJclDebugExtension.AfterCompile(const Project: IOTAProject; Succeeded: Boolean);
 var
   ProjectFileName, MapFileName, DrcFileName, ExecutableFileName, JdbgFileName: TFileName;
   OutputDirectory, LinkerBugUnit: string;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3206] trunk/jcl/experts/debug/converter

From: <ah...@us...> - 2010-03-04 21:17:14

Revision: 3206
          http://jcl.svn.sourceforge.net/jcl/?rev=3206&view=rev
Author:   ahuser
Date:     2010-03-04 21:17:07 +0000 (Thu, 04 Mar 2010)

Log Message:
-----------
Less access violations due to an invalid FCurrentProject interface (IOTAIDENotifier80.AfterCompile)

Modified Paths:
--------------
    trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
    trunk/jcl/experts/debug/converter/JclDebugIdeResult.dfm
    trunk/jcl/experts/debug/converter/JclDebugIdeResult.pas

Modified: trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas	2010-03-03 22:55:01 UTC (rev 3205)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas	2010-03-04 21:17:07 UTC (rev 3206)
@@ -71,7 +71,6 @@
     FNoInsertJdbgImageIndex: Integer;
     FDeleteMapFileImageIndex: Integer;
     FNoDeleteMapFileImageIndex: Integer;
-    FCurrentProject: IOTAProject;
     FSaveBuildProjectAction: TCustomAction;
     FSaveBuildProjectActionExecute: TNotifyEvent;
     FSaveBuildAllProjectsAction: TCustomAction;
@@ -116,7 +115,7 @@
     function GetProjectActions(const AProject: IOTAProject): TDebugExpertActions;
   public
     constructor Create; reintroduce;
-    procedure AfterCompile(Succeeded: Boolean);
+    procedure AfterCompile(Succeeded: Boolean; const Project: IOTAProject);
     procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
     procedure RegisterCommands; override;
     procedure UnregisterCommands; override;
@@ -130,9 +129,13 @@
     property ProjectActions[const AProject: IOTAProject]: TDebugExpertActions read GetProjectActions;
   end;
 
-  TIdeNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier, IOTAIDENotifier50)
+  TIdeNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier, IOTAIDENotifier50
+                       {$IFDEF BDS7_UP}, IOTAIDENotifier80{$ENDIF})
   private
     FDebugExtension: TJclDebugExtension;
+    {$IFNDEF BDS7_UP}
+    FCurrentProject: IOTAProject;
+    {$ENDIF ~BDS7_UP}
   public
     constructor Create(ADebugExtension: TJclDebugExtension);
     { IOTAIDENotifier }
@@ -142,6 +145,8 @@
     { IOTAIDENotifier50 }
     procedure BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean); overload;
     procedure AfterCompile(Succeeded: Boolean; IsCodeInsight: Boolean); overload;
+    { IOTAIDENotifier80 }
+    procedure AfterCompile(const Project: IOTAProject; Succeeded: Boolean; IsCodeInsight: Boolean); overload;
   end;
 
   {$IFDEF BDS7_UP}
@@ -233,21 +238,19 @@
   JclBase, JclIDEUtils, JclDebug, JclDebugIdeResult,
   JclOtaResources;
 
+var
+  JCLWizardIndex: Integer = -1;
+
 procedure Register;
 begin
   try
     RegisterPackageWizard(TJclDebugExtension.Create);
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
-var
-  JCLWizardIndex: Integer = -1;
-
 procedure JclWizardTerminate;
 begin
   try
@@ -255,15 +258,12 @@
       TJclOTAExpertBase.GetOTAWizardServices.RemoveWizard(JCLWizardIndex);
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
 function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
-    RegisterProc: TWizardRegisterProc;
-    var TerminateProc: TWizardTerminateProc): Boolean stdcall;
+  RegisterProc: TWizardRegisterProc; var TerminateProc: TWizardTerminateProc): Boolean stdcall;
 begin
   try
     TerminateProc := JclWizardTerminate;
@@ -282,8 +282,7 @@
 
 //=== { TJclDebugExtension } =================================================
 
-procedure TJclDebugExtension.ConfigurationClosed(AControl: TControl;
-  SaveChanges: Boolean);
+procedure TJclDebugExtension.ConfigurationClosed(AControl: TControl; SaveChanges: Boolean);
 begin
   if Assigned(AControl) and (AControl = FConfigFrame) then
   begin
@@ -304,8 +303,7 @@
   inherited Create(JclDebugExpertRegKey);
 end;
 
-procedure TJclDebugExtension.AddConfigurationPages(
-  AddPageFunc: TJclOTAAddPageFunc);
+procedure TJclDebugExtension.AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc);
 begin
   inherited AddConfigurationPages(AddPageFunc);
   FConfigFrame := TJclDebugIdeConfigFrame.Create(nil);
@@ -315,7 +313,7 @@
   AddPageFunc(FConfigFrame, LoadResString(@RsDebugConfigPageCaption), Self);
 end;
 
-procedure TJclDebugExtension.AfterCompile(Succeeded: Boolean);
+procedure TJclDebugExtension.AfterCompile(Succeeded: Boolean; const Project: IOTAProject);
 var
   ProjectFileName, MapFileName, DrcFileName, ExecutableFileName, JdbgFileName: TFileName;
   OutputDirectory, LinkerBugUnit: string;
@@ -326,24 +324,24 @@
 
   procedure OutputToolMessage(const Msg: string);
   begin
-    if Assigned(FCurrentProject) then
-      OTAMessageServices.AddToolMessage(FCurrentProject.FileName, Msg, LoadResString(@RsJclDebugMessagePrefix), 1, 1)
+    if Assigned(Project) then
+      OTAMessageServices.AddToolMessage(Project.FileName, Msg, LoadResString(@RsJclDebugMessagePrefix), 1, 1)
     else
       OTAMessageServices.AddToolMessage('', Msg, LoadResString(@RsJclDebugMessagePrefix), 1, 1);
   end;
 
 begin
-  if JclDisablePostCompilationProcess or (FCurrentProject = nil) then
+  if JclDisablePostCompilationProcess or (Project = nil) then
     Exit;
 
   OTAMessageServices := GetOTAMessageServices;
-  EnabledActions := GetProjectActions(FCurrentProject);
+  EnabledActions := GetProjectActions(Project);
   if EnabledActions <> [] then
   begin
-    ProjectFileName := FCurrentProject.FileName;
-    OutputDirectory := GetOutputDirectory(FCurrentProject);
-    MapFileName := GetMapFileName(FCurrentProject);
-    DrcFileName := GetDrcFileName(FCurrentProject);
+    ProjectFileName := Project.FileName;
+    OutputDirectory := GetOutputDirectory(Project);
+    MapFileName := GetMapFileName(Project);
+    DrcFileName := GetDrcFileName(Project);
     JdbgFileName := ChangeFileExt(MapFileName, JclDbgFileExtension);
 
     if Succeeded then
@@ -420,8 +418,7 @@
     end
     else
       FBuildError := True;
-    FCurrentProject := nil;
-  end;
+  end
 end;
 
 procedure TJclDebugExtension.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
@@ -456,7 +453,6 @@
     end
     else
     begin
-      FCurrentProject := Project;
       ProjOptions := Project.ProjectOptions;
       if not Assigned(ProjOptions) then
         raise EJclExpertException.CreateRes(@RsENoProjectOptions);
@@ -660,9 +656,7 @@
     end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -686,9 +680,7 @@
       AAction.ImageIndex := FNoDebugImageIndex;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -708,9 +700,7 @@
     FDeleteMapFileItem.Checked := deDeleteMapFile in EnabledActions;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -757,9 +747,7 @@
     end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -785,9 +773,7 @@
     end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -803,9 +789,7 @@
       GlobalStates[deDeleteMapFile] := ToggleDebugExpertState(GlobalStates[deDeleteMapFile]);
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -832,9 +816,7 @@
     end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -860,9 +842,7 @@
     end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -889,9 +869,7 @@
     end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -909,9 +887,7 @@
       GlobalStates[deDeleteMapFile] := AState;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -927,9 +903,7 @@
       GlobalStates[deGenerateJdbg] := ToggleDebugExpertState(GlobalStates[deGenerateJdbg]);
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -956,9 +930,7 @@
     end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -984,9 +956,7 @@
     end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -1013,9 +983,7 @@
     end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -1033,9 +1001,7 @@
       GlobalStates[deGenerateJdbg] := AState;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -1111,9 +1077,7 @@
       GlobalStates[deInsertJdbg] := ToggleDebugExpertState(GlobalStates[deInsertJdbg]);
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -1140,9 +1104,7 @@
     end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -1168,9 +1130,7 @@
     end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -1197,9 +1157,7 @@
     end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -1217,9 +1175,7 @@
       GlobalStates[deInsertJdbg] := AState;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -1572,14 +1528,29 @@
 
 procedure TIdeNotifier.AfterCompile(Succeeded, IsCodeInsight: Boolean);
 begin
+  {$IFNDEF BDS7_UP}
   try
+    try
+      if not IsCodeInsight then
+        FDebugExtension.AfterCompile(Succeeded, FCurrentProject);
+    finally
+      FCurrentProject := nil;
+    end;
+  except
+    on ExceptionObj: Exception do
+      JclExpertShowExceptionDialog(ExceptionObj);
+  end;
+  {$ENDIF ~BDS7_UP}
+end;
+
+procedure TIdeNotifier.AfterCompile(const Project: IOTAProject; Succeeded: Boolean; IsCodeInsight: Boolean);
+begin
+  try
     if not IsCodeInsight then
-      FDebugExtension.AfterCompile(Succeeded);
+      FDebugExtension.AfterCompile(Succeeded, Project);
   except
-    on ExceptionObj: TObject do
-    begin
+    on ExceptionObj: Exception do
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -1587,12 +1558,15 @@
 begin
   try
     if not IsCodeInsight then
+    begin
+      {$IFNDEF BDS7_UP}
+      FCurrentProject := Project;
+      {$ENDIF ~BDS7_UP}
       FDebugExtension.BeforeCompile(Project, Cancel);
+    end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -1713,9 +1687,7 @@
     end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -1746,9 +1718,7 @@
     end;
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -1908,9 +1878,7 @@
       raise EJclExpertException.CreateRes(@RsENoActiveProject);
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -1928,9 +1896,7 @@
       raise EJclExpertException.CreateRes(@RsENoActiveProject);
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 
@@ -1948,9 +1914,7 @@
       raise EJclExpertException.CreateRes(@RsENoActiveProject);
   except
     on ExceptionObj: TObject do
-    begin
       JclExpertShowExceptionDialog(ExceptionObj);
-    end;
   end;
 end;
 

Modified: trunk/jcl/experts/debug/converter/JclDebugIdeResult.dfm
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeResult.dfm	2010-03-03 22:55:01 UTC (rev 3205)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeResult.dfm	2010-03-04 21:17:07 UTC (rev 3206)
@@ -18,10 +18,10 @@
   OldCreateOrder = False
   Position = poScreenCenter
   ShowHint = True
-  OnCreate = FormCreate
   OnDestroy = FormDestroy
   OnKeyDown = FormKeyDown
   OnResize = FormResize
+  OnShow = FormShow
   Width = 772
   Height = 303
   PixelsPerInch = 96

Modified: trunk/jcl/experts/debug/converter/JclDebugIdeResult.pas
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeResult.pas	2010-03-03 22:55:01 UTC (rev 3205)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeResult.pas	2010-03-04 21:17:07 UTC (rev 3206)
@@ -42,7 +42,7 @@
     ResultListView: TListView;
     ImageList1: TImageList;
     procedure FormDestroy(Sender: TObject);
-    procedure FormCreate(Sender: TObject);
+    procedure FormShow(Sender: TObject);
     procedure FormResize(Sender: TObject);
     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
   private
@@ -181,7 +181,7 @@
     Params.WndParent := Application.Handle;
 end;
 
-procedure TJclDebugResultForm.FormCreate(Sender: TObject);
+procedure TJclDebugResultForm.FormShow(Sender: TObject);
 var
   Index: Integer;
 begin


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3205] trunk/jcl

From: <usc...@us...> - 2010-03-03 22:55:13

Revision: 3205
          http://jcl.svn.sourceforge.net/jcl/?rev=3205&view=rev
Author:   uschuster
Date:     2010-03-03 22:55:01 +0000 (Wed, 03 Mar 2010)

Log Message:
-----------
debug library units are as of now compiled against Delphi's debug DCUs to avoid problems when enabling Delphi's project option "Use debug .dcus"
(Mantis #5186)

Modified Paths:
--------------
    trunk/jcl/install/JclInstall.pas
    trunk/jcl/source/common/JclCompilerUtils.pas
    trunk/jcl/source/common/JclIDEUtils.pas

Modified: trunk/jcl/install/JclInstall.pas
===================================================================
--- trunk/jcl/install/JclInstall.pas	2010-03-02 12:46:49 UTC (rev 3204)
+++ trunk/jcl/install/JclInstall.pas	2010-03-03 22:55:01 UTC (rev 3205)
@@ -2369,7 +2369,7 @@
 
     Compiler := Target.DCC32;
 
-    Compiler.SetDefaultOptions;
+    Compiler.SetDefaultOptions(Debug);
     //Options.Add('-D' + StringsToStr(Defines, ';'));
     Compiler.Options.Add('-M');   // make modified units
     Compiler.Options.Add('-$X+'); // extended syntax
@@ -2528,7 +2528,7 @@
   try
     SetCurrentDir(NewDirectory);
     Target.DCC32.Options.Clear;
-    Target.DCC32.SetDefaultOptions;
+    Target.DCC32.SetDefaultOptions(False);
     Target.DCC32.AddPathOption('E', Distribution.JclBinDir);
     Target.DCC32.AddPathOption('N', '.');
     Target.DCC32.AddPathOption('U', FLibReleaseDir + DirSeparator + Distribution.JclSourcePath);

Modified: trunk/jcl/source/common/JclCompilerUtils.pas
===================================================================
--- trunk/jcl/source/common/JclCompilerUtils.pas	2010-03-02 12:46:49 UTC (rev 3204)
+++ trunk/jcl/source/common/JclCompilerUtils.pas	2010-03-03 22:55:01 UTC (rev 3205)
@@ -113,6 +113,7 @@
   private
     FDCPSearchPath: string;
     FLibrarySearchPath: string;
+    FLibraryDebugSearchPath: string;
     FCppSearchPath: string;
     FSupportsNoConfig: Boolean;
   protected
@@ -121,18 +122,21 @@
   public
     constructor Create(const ABinDirectory: string; ALongPathBug: Boolean;
       ACompilerSettingsFormat: TJclCompilerSettingsFormat; ASupportsNoConfig: Boolean;
-      const ADCPSearchPath, ALibrarySearchPath, ACppSearchPath: string);
+      const ADCPSearchPath, ALibrarySearchPath, ALibraryDebugSearchPath, ACppSearchPath: string);
     function GetExeName: string; override;
     function Execute(const CommandLine: string): Boolean; override;
-    function MakePackage(const PackageName, BPLPath, DCPPath: string; ExtraOptions: string = ''): Boolean;
-    function MakeProject(const ProjectName, OutputDir, DcpSearchPath: string; ExtraOptions: string = ''): Boolean;
-    procedure SetDefaultOptions; virtual;
+    function MakePackage(const PackageName, BPLPath, DCPPath: string;
+      ExtraOptions: string = ''; ADebug: Boolean = False): Boolean;
+    function MakeProject(const ProjectName, OutputDir, DcpSearchPath: string;
+      ExtraOptions: string = ''; ADebug: Boolean = False): Boolean;
+    procedure SetDefaultOptions(ADebug: Boolean); virtual;
     function AddBDSProjOptions(const ProjectFileName: string; var ProjectOptions: TProjectOptions): Boolean;
     function AddDOFOptions(const ProjectFileName: string; var ProjectOptions: TProjectOptions): Boolean;
     function AddDProjOptions(const ProjectFileName: string; var ProjectOptions: TProjectOptions): Boolean;
     property CppSearchPath: string read FCppSearchPath;
     property DCPSearchPath: string read FDCPSearchPath;
     property LibrarySearchPath: string read FLibrarySearchPath;
+    property LibraryDebugSearchPath: string read FLibraryDebugSearchPath;
     property SupportsNoConfig: Boolean read FSupportsNoConfig;
   end;
 
@@ -144,8 +148,9 @@
     function GetMaxCLRVersion: string;
   public
     function GetExeName: string; override;
-    function MakeProject(const ProjectName, OutputDir, ExtraOptions: string): Boolean; reintroduce;
-    procedure SetDefaultOptions; override;
+    function MakeProject(const ProjectName, OutputDir, ExtraOptions: string;
+      ADebug: Boolean = False): Boolean; reintroduce;
+    procedure SetDefaultOptions(ADebug: Boolean); override;
     property MaxCLRVersion: string read GetMaxCLRVersion;
   end;
   {$ENDIF MSWINDOWS}
@@ -1022,14 +1027,15 @@
 
 constructor TJclDCC32.Create(const ABinDirectory: string; ALongPathBug: Boolean;
   ACompilerSettingsFormat: TJclCompilerSettingsFormat; ASupportsNoConfig: Boolean;
-  const ADCPSearchPath, ALibrarySearchPath, ACppSearchPath: string);
+  const ADCPSearchPath, ALibrarySearchPath, ALibraryDebugSearchPath, ACppSearchPath: string);
 begin
   inherited Create(ABinDirectory, ALongPathBug, ACompilerSettingsFormat);
   FSupportsNoConfig := ASupportsNoConfig;
   FDCPSearchPath := ADCPSearchPath;
   FLibrarySearchPath := ALibrarySearchPath;
+  FLibraryDebugSearchPath := ALibraryDebugSearchPath;
   FCppSearchPath := ACppSearchPath;
-  SetDefaultOptions; // in case $(DELPHI)\bin\dcc32.cfg (replace as appropriate) is invalid
+  SetDefaultOptions(False); // in case $(DELPHI)\bin\dcc32.cfg (replace as appropriate) is invalid
 end;
 
 function TJclDCC32.Execute(const CommandLine: string): Boolean;
@@ -1117,7 +1123,7 @@
   Result := DCC32ExeName;
 end;
 
-function TJclDCC32.MakePackage(const PackageName, BPLPath, DCPPath: string; ExtraOptions: string): Boolean;
+function TJclDCC32.MakePackage(const PackageName, BPLPath, DCPPath: string; ExtraOptions: string = ''; ADebug: Boolean = False): Boolean;
 var
   SaveDir: string;
   ConfigurationFileName, BackupFileName: string;
@@ -1131,7 +1137,7 @@
       FileBackup(ConfigurationFileName, True);
 
     Options.Clear;
-    SetDefaultOptions;
+    SetDefaultOptions(ADebug);
     AddProjectOptions(PackageName, DCPPath);
     try
       AddPathOption('LN', DCPPath);
@@ -1150,7 +1156,7 @@
 end;
 
 function TJclDCC32.MakeProject(const ProjectName, OutputDir, DcpSearchPath: string;
-  ExtraOptions: string): Boolean;
+  ExtraOptions: string = ''; ADebug: Boolean = False): Boolean;
 var
   SaveDir: string;
   ConfigurationFileName, BackupFileName: string;
@@ -1164,7 +1170,7 @@
       FileBackup(ConfigurationFileName, True);
 
     Options.Clear;
-    SetDefaultOptions;
+    SetDefaultOptions(ADebug);
     AddProjectOptions(ProjectName, DcpSearchPath);
     try
       AddPathOption('E', OutputDir);
@@ -1181,11 +1187,13 @@
   end;
 end;
 
-procedure TJclDCC32.SetDefaultOptions;
+procedure TJclDCC32.SetDefaultOptions(ADebug: Boolean);
 begin
   Options.Clear;
   if SupportsNoConfig then
     Options.Add('--no-config');
+  if ADebug then
+    AddPathOption('U', LibraryDebugSearchPath);
   AddPathOption('U', LibrarySearchPath);
   if CppSearchPath <> '' then
   begin
@@ -1232,7 +1240,7 @@
 end;
 
 function TJclDCCIL.MakeProject(const ProjectName, OutputDir,
-  ExtraOptions: string): Boolean;
+  ExtraOptions: string; ADebug: Boolean = False): Boolean;
 var
   SaveDir: string;
 begin
@@ -1240,7 +1248,7 @@
   SetCurrentDir(ExtractFilePath(ProjectName) + '.');
   try
     Options.Clear;
-    SetDefaultOptions;
+    SetDefaultOptions(ADebug);
     AddProjectOptions(ProjectName, '');
     AddPathOption('E', OutputDir);
     Options.Add(ExtraOptions);
@@ -1250,9 +1258,11 @@
   end;
 end;
 
-procedure TJclDCCIL.SetDefaultOptions;
+procedure TJclDCCIL.SetDefaultOptions(ADebug: Boolean);
 begin
   Options.Clear;
+  if ADebug then
+    AddPathOption('U', LibraryDebugSearchPath);
   AddPathOption('U', LibrarySearchPath);
 end;
 

Modified: trunk/jcl/source/common/JclIDEUtils.pas
===================================================================
--- trunk/jcl/source/common/JclIDEUtils.pas	2010-03-02 12:46:49 UTC (rev 3204)
+++ trunk/jcl/source/common/JclIDEUtils.pas	2010-03-03 22:55:01 UTC (rev 3205)
@@ -1895,7 +1895,7 @@
     if not (clDcc32 in CommandLineTools) then
       raise EJclBorRadException.CreateResFmt(@RsENotFound, [Dcc32ExeName]);
     FDCC32 := TJclDCC32.Create(BinFolderName, LongPathBug, CompilerSettingsFormat,
-                               SupportsNoConfig, DCPOutputPath, LibFolderName, ObjFolderName);
+                               SupportsNoConfig, DCPOutputPath, LibFolderName, LibDebugFolderName, ObjFolderName);
   end;
   Result := FDCC32;
 end;
@@ -3358,7 +3358,7 @@
     if not (clDccIL in CommandLineTools) then
       raise EJclBorRadException.CreateResFmt(@RsENotFound, [DccILExeName]);
     FDCCIL := TJclDCCIL.Create(BinFolderName, LongPathBug, CompilerSettingsFormat,
-                               SupportsNoConfig, DCPOutputPath, LibFolderName, ObjFolderName);
+                               SupportsNoConfig, DCPOutputPath, LibFolderName, LibDebugFolderName, ObjFolderName);
   end;
   Result := FDCCIL;
 end;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3204] trunk/jcl/source/common/JclSimpleXml.pas

From: <ob...@us...> - 2010-03-02 12:46:56

Revision: 3204
          http://jcl.svn.sourceforge.net/jcl/?rev=3204&view=rev
Author:   obones
Date:     2010-03-02 12:46:49 +0000 (Tue, 02 Mar 2010)

Log Message:
-----------
Added BaseIndentString to allow the saving of file with an additional indent applied to all lines
Fixed the setter of IndentString which only accepted non white space strings instead of refusing them.

Modified Paths:
--------------
    trunk/jcl/source/common/JclSimpleXml.pas

Modified: trunk/jcl/source/common/JclSimpleXml.pas
===================================================================
--- trunk/jcl/source/common/JclSimpleXml.pas	2010-03-01 21:33:35 UTC (rev 3203)
+++ trunk/jcl/source/common/JclSimpleXml.pas	2010-03-02 12:46:49 UTC (rev 3204)
@@ -439,11 +439,13 @@
     FSaveCount: Integer;
     FSaveCurrent: Integer;
     FIndentString: string;
+    FBaseIndentString: string;
     FOnEncodeValue: TJclSimpleXMLEncodeEvent;
     FOnDecodeValue: TJclSimpleXMLEncodeEvent;
     FOnDecodeStream: TJclSimpleXMLEncodeStreamEvent;
     FOnEncodeStream: TJclSimpleXMLEncodeStreamEvent;
     procedure SetIndentString(const Value: string);
+    procedure SetBaseIndentString(const Value: string);
     procedure SetRoot(const Value: TJclSimpleXMLElemClassic);
     procedure SetFileName(const Value: TFileName);
     procedure DoLoadProgress(const APosition, ATotal: Integer);
@@ -469,6 +471,7 @@
     property XMLData: string read SaveToString write LoadFromString;
     property FileName: TFileName read FFileName write SetFileName;
     property IndentString: string read FIndentString write SetIndentString;
+    property BaseIndentString: string read FBaseIndentString write SetBaseIndentString;
     property Options: TJclSimpleXMLOptions read FOptions write FOptions;
     property OnSaveProgress: TJclOnSimpleProgress read FOnSaveProg write FOnSaveProg;
     property OnLoadProgress: TJclOnSimpleProgress read FOnLoadProg write FOnLoadProg;
@@ -1173,7 +1176,7 @@
   if not (sxoDoNotSaveProlog in FOptions) then
     Prolog.SaveToStringStream(StringStream, Self);
 
-  Root.SaveToStringStream(StringStream, '', Self);
+  Root.SaveToStringStream(StringStream, BaseIndentString, Self);
 
   if Assigned(FOnSaveProg) then
     FOnSaveProg(Self, lCount, lCount);
@@ -1192,6 +1195,15 @@
   end;
 end;
 
+procedure TJclSimpleXML.SetBaseIndentString(const Value: string);
+begin
+  // test if the new value is only made of spaces or tabs
+  if not StrContainsChars(Value, CharIsWhiteSpace, True) then
+    Exit;
+
+  FBaseIndentString := Value;
+end;
+
 procedure TJclSimpleXML.SetFileName(const Value: TFileName);
 begin
   FFileName := Value;
@@ -3748,7 +3760,7 @@
 procedure TJclSimpleXML.SetIndentString(const Value: string);
 begin
   // test if the new value is only made of spaces or tabs
-  if StrContainsChars(Value,CharIsWhiteSpace,True) then
+  if not StrContainsChars(Value, CharIsWhiteSpace, True) then
     Exit;
   FIndentString := Value;
 end;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3203] trunk/jcl/devtools/jpp/JppState.pas

From: <jfu...@us...> - 2010-03-01 21:33:41

Revision: 3203
          http://jcl.svn.sourceforge.net/jcl/?rev=3203&view=rev
Author:   jfudickar
Date:     2010-03-01 21:33:35 +0000 (Mon, 01 Mar 2010)

Log Message:
-----------
Mantis 0005183: SVN Revision 3202 fails to install. 

Revision Links:
--------------
    http://jcl.svn.sourceforge.net/jcl/?rev=3202&view=rev

Modified Paths:
--------------
    trunk/jcl/devtools/jpp/JppState.pas

Modified: trunk/jcl/devtools/jpp/JppState.pas
===================================================================
--- trunk/jcl/devtools/jpp/JppState.pas	2010-02-22 18:42:06 UTC (rev 3202)
+++ trunk/jcl/devtools/jpp/JppState.pas	2010-03-01 21:33:35 UTC (rev 3203)
@@ -355,7 +355,11 @@
     PI := GetPropInfo(Self, ASymbol);
     if Assigned(PI) then
     begin
+      {$IFDEF DELPHI8_UP}   	  
       PV := GetPropValue(Self, PI);
+      {$ELSE}
+      PV := GetPropValue(Self, PI^.Name);
+      {$ENDIF}
       if Boolean(PV) then
         Result := ttDefined
       else
@@ -480,9 +484,17 @@
     if Assigned(PI) then
     begin
       if Value = ttDefined then
+        {$IFDEF DELPHI8_UP}   	  
         SetPropValue(Self, PI, True)
+        {$ELSE}
+        SetPropValue(Self, PI^.Name, True)
+        {$ENDIF}
       else
+        {$IFDEF DELPHI8_UP}   	  
         SetPropValue(Self, PI, False);
+		{$ELSE}
+        SetPropValue(Self, PI^.Name, False);
+		{$ENDIF}
       Exit;
     end;
   end;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3202] trunk/jcl/devtools/jpp

From: <ou...@us...> - 2010-02-22 18:42:13

Revision: 3202
          http://jcl.svn.sourceforge.net/jcl/?rev=3202&view=rev
Author:   outchy
Date:     2010-02-22 18:42:06 +0000 (Mon, 22 Feb 2010)

Log Message:
-----------
Move all JPP main units to a dedicated unit. That will make code share easy.

Modified Paths:
--------------
    trunk/jcl/devtools/jpp/jpp.dpr

Added Paths:
-----------
    trunk/jcl/devtools/jpp/JppMain.pas

Copied: trunk/jcl/devtools/jpp/JppMain.pas (from rev 3199, trunk/jcl/devtools/jpp/jpp.dpr)
===================================================================
--- trunk/jcl/devtools/jpp/JppMain.pas	                        (rev 0)
+++ trunk/jcl/devtools/jpp/JppMain.pas	2010-02-22 18:42:06 UTC (rev 3202)
@@ -0,0 +1,386 @@
+{ **************************************************************************** }
+{                                                                              }
+{    Pascal PreProcessor                                                       }
+{    Copyright (c) 2001 Barry Kelly.                                           }
+{    bar...@ho...                                                 }
+{                                                                              }
+{    The contents of this file are subject to the Mozilla Public License       }
+{    Version 1.1 (the "License"); you may not use this file except in          }
+{    compliance with the License. You may obtain a copy of the License at      }
+{    http://www.mozilla.org/MPL/                                               }
+{                                                                              }
+{    Software distributed under the License is distributed on an "AS IS"       }
+{    basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the   }
+{    License for the specific language governing rights and limitations        }
+{    under the License.                                                        }
+{                                                                              }
+{    The Original Code is ppp.dpr                                              }
+{                                                                              }
+{    The Initial Developer of the Original Code is Barry Kelly.                }
+{    Portions created by Barry Kelly are Copyright (C) 2001                    }
+{    Barry Kelly. All Rights Reserved.                                         }
+{                                                                              }
+{    Contributors:                                                             }
+{      Robert Rossmair,                                                        }
+{      Peter Th\xF6rnqvist,                                                       }
+{      Florent Ouchet                                                          }
+{                                                                              }
+{    Alternatively, the contents of this file may be used under the terms      }
+{    of the Lesser GNU Public License (the  "LGPL License"), in which case     }
+{    the provisions of LGPL License are applicable instead of those            }
+{    above.  If you wish to allow use of your version of this file only        }
+{    under the terms of the LPGL License and not to allow others to use        }
+{    your version of this file under the MPL, indicate your decision by        }
+{    deleting  the provisions above and replace  them with the notice and      }
+{    other provisions required by the LGPL License.  If you do not delete      }
+{    the provisions above, a recipient may use your version of this file       }
+{    under either the MPL or the LPGL License.                                 }
+{                                                                              }
+{ **************************************************************************** }
+
+// Last modified: $Date$
+
+unit JppMain;
+
+interface
+
+uses
+  SysUtils,
+  Classes,
+  JclFileUtils,
+  JclStrings,
+  JclStreams,
+  JclSysUtils,
+  JppState,
+  JppParser;
+
+procedure Syntax;
+procedure Params(ACommandLine: PChar);
+
+implementation
+
+const
+  SubstChar = '_';
+  ProcessedExtension = '.jpp';
+  SWarningJppGenerated =
+    '{**************************************************************************************************}'#13#10 +
+    '{  WARNING:  JEDI preprocessor generated unit.  Do not edit.                                       }'#13#10 +
+    '{**************************************************************************************************}'#13#10;
+
+procedure Syntax;
+begin
+  Writeln(
+    'JEDI PreProcessor v. 2004-12-03'#10,
+    'Copyright (C) 2001 Barry Kelly'#10,
+    #10,
+    'Syntax:'#10,
+    '  ' + ParamStr(0) + ' [options] <input files>...'#10,
+    #10,
+    'Options:'#10,
+    '  -c'#9#9'Process conditional directives'#10,
+    '  -m'#9#9'Process macro directive'#10,
+    '  -v'#9#9'Process value directive'#10,
+    '  -C'#9#9'Strip comments'#10,
+    '  -fxxx'#9#9'Prefix xxx to filename'#10,
+    '  -h, -?'#9'This help'#10,
+    '  -i[x[,y...]]'#9'Process includes, except files x, y, ...'#10,
+    '  -pxxx'#9#9'Add xxx to include path'#10,
+    '  -dxxx'#9#9'Define xxx as a preprocessor conditional symbol'#10,
+    '  -uxxx'#9#9'Assume preprocessor conditional symbol xxx as not defined'#10,
+    '  -rx[,y...]'#9'Comma-separated list of strings to replace underscores'#10,
+    #9#9'in input file names with'#10,
+    //'  -x[n:]yyy'#9'Strip first n characters from file name; precede filename by prefix yyy'#10,
+    #10,
+    'When required to prevent the original file from being overwritten, '#10 +
+    'the processed file''s extension will be changed to ', ProcessedExtension, #10,
+    'If you have any suggestions or bug-reports, contact me at'#10,
+    'bar...@ho...'
+  );
+  Halt(2);
+end;
+
+procedure Process(AState: TPppState; const AOld, ANew: string);
+var
+  parse: TJppParser;
+  fsIn, fsOut: TStream;
+  ssIn: TJclAutoStream;
+  ssOut: TJclStringStream;
+  answer: string;
+begin
+  fsOut := nil;
+  parse := nil;
+  fsIn := nil;
+  ssIn := nil;
+  ssOut := nil;
+  AState.PushState;
+  try
+    fsIn := TFileStream.Create(AOld, fmOpenRead);
+    ssIn := TJclAutoStream.Create(fsIn);
+    parse := TJppParser.Create(ssIn.ReadString, AState);
+    answer := Format('%s'#13#10'%s', [SWarningJppGenerated, parse.Parse]);
+    fsOut := TFileStream.Create(ANew, fmCreate);
+    case ssIn.Encoding of
+      seAnsi:
+        ssOut := TJclAnsiStream.Create(fsOut);
+      seUTF8:
+        ssOut := TJclUTF8Stream.Create(fsOut);
+      seUTF16:
+        ssOut := TJclUTF16Stream.Create(fsOut);
+    else
+      WriteLn('Unknown encoding for file ' + AOld);
+      Abort;
+    end;
+    ssOut.WriteString(answer, 1, Length(answer));
+  finally
+    AState.PopState;
+    ssOut.Free;
+    fsOut.Free;
+    parse.Free;
+    ssIn.Free;
+    fsIn.Free;
+  end;
+end;
+
+procedure Substitute(var S: string; SubstChar: Char; SubstStrings: TStrings);
+var
+  I, J, K, N, Count: Integer;
+  Result, SubstString: string;
+  SubstDone: Boolean;
+begin
+  if SubstStrings = nil then
+    Exit;
+
+  Count := SubstStrings.Count;
+
+  if Count = 0 then
+    Exit;
+
+  SetLength(Result, Length(S) + Length(SubstStrings.Text)); // sufficient length
+  J := 1;
+  N := 0;
+  SubstDone := False;
+  for I := 1 to Length(S) do
+    if (S[I] = SubstChar) and not SubstDone then
+    begin
+      SubstString := SubstStrings[N];
+      for K := 1 to Length(SubstString) do
+      begin
+        Result[J] := SubstString[K];
+        Inc(J);
+      end;
+      Inc(N);
+      SubstDone := N = SubstStrings.Count;
+    end
+    else
+    begin
+      Result[J] := S[I];
+      Inc(J);
+    end;
+  SetLength(Result, J - 1);
+  S := Result;
+end;
+
+procedure Params(ACommandLine: PChar);
+var
+  pppState: TPppState;
+  StripLength: Integer; // RR
+  Prefix, ReplaceString: string; // RR
+  N: Integer;
+  ReplaceStrings: TStringList;
+
+  function ReadStringDoubleQuotedMaybe(cp: PChar; var AStr: string): PChar;
+  begin
+    { possibly quoted string }
+    Result := cp;
+    if Result^ = '"' then
+    begin
+      while (Result^ <> #0) and (Result^ <> '"') do
+        Inc(Result);
+      if Result^ = #0 then
+        raise Exception.Create('Unterminated string');
+      Inc(Result); // skip over final "
+      SetString(AStr, cp, Result - cp);
+    end
+    else
+    begin
+      while (Result^ <> #0) and not CharIsSpace(Result^) do
+        Inc(Result);
+      SetString(AStr, cp, Result - cp);
+    end;
+  end;
+
+  function HandleOptions(cp: PChar): PChar;
+
+    function CheckOpt(cp: PChar; AOpt: TPppOption): PChar;
+    begin
+      case cp^ of
+        '+':
+          begin
+            pppState.Options := pppState.Options + [AOpt];
+            Result := cp + 1;
+          end;
+        '-':
+          begin
+            pppState.Options := pppState.Options - [AOpt];
+            Result := cp + 1;
+          end;
+      else
+        pppState.Options := pppState.Options + [AOpt];
+        Result := cp;
+      end;
+    end;
+
+  var
+    tmp: string;
+    i: Integer;
+  begin
+    StrSkipChars(cp, CharIsWhiteSpace);
+
+    while cp^ = '-' do
+    begin
+      Inc(cp);
+
+      case cp^ of
+        'f', 'F': // RR
+          begin
+            Inc(cp);
+            cp := ReadStringDoubleQuotedMaybe(cp, Prefix);
+            Prefix := ExpandUNCFilename(Prefix);
+          end;
+
+        'h', 'H', '?':
+          Syntax;
+
+        'i', 'I':
+          begin
+            cp := ReadStringDoubleQuotedMaybe(CheckOpt(cp + 1, poProcessIncludes), tmp);
+            for i := 0 to ListItemCount(tmp, DirSeparator) - 1 do
+              pppState.AddFileToExclusionList(ListGetItem(tmp, DirSeparator, i));
+          end;
+
+        'c':
+          cp := CheckOpt(cp + 1, poProcessDefines);
+
+        'm':
+          cp := CheckOpt(cp + 1, poProcessMacros);
+
+        'v':
+          cp := CheckOpt(cp + 1, poProcessValues);
+
+        'C':
+          cp := CheckOpt(cp + 1, poStripComments);
+
+        'p', 'P':
+          begin
+            Inc(cp);
+            cp := ReadStringDoubleQuotedMaybe(cp, tmp);
+            pppState.AddToSearchPath(ExpandUNCFileName(tmp));
+          end;
+
+        'd':
+          begin
+            Inc(cp);
+            StrIdent(cp, tmp);
+            pppState.Define(tmp);
+          end;
+
+        'r':
+          begin
+            Inc(cp);
+            cp := ReadStringDoubleQuotedMaybe(cp, ReplaceString);
+            ReplaceStrings.CommaText := ReplaceString;
+          end;
+
+        'u': // RR
+          begin
+            Inc(cp);
+            StrIdent(cp, tmp);
+            pppState.Undef(tmp);
+          end;
+
+        'x', 'X': // RR
+          begin
+            Inc(cp);
+            cp := ReadStringDoubleQuotedMaybe(cp, Prefix);
+            Val(Prefix, StripLength, N);
+            if N > 1 then
+              Prefix := Copy(Prefix, N + 1, Length(Prefix));
+            Prefix := ExpandUNCFilename(Prefix);
+          end;
+
+      else
+        Syntax;
+      end;
+
+      StrSkipChars(cp, CharIsWhiteSpace);
+    end;
+    Result := cp;
+  end;
+
+  function HandleFiles(cp: PChar): PChar;
+  var
+    FileName, NewName, tmp: string;
+    Files: TStrings;
+    I: Integer;
+  begin
+    while (cp^ <> '-') and (cp^ <> #0) do
+    begin
+      cp := ReadStringDoubleQuotedMaybe(cp, tmp);
+      StrSkipChars(cp, CharIsWhiteSpace);
+
+      Files := TStringList.Create;
+      try
+        AdvBuildFileList( ExpandUNCFileName(tmp), faAnyFile, Files, amAny);
+
+        if Files.Count > 0 then
+          for I := 0 to Files.Count - 1 do
+          begin
+            FileName := Files.Strings[I];
+            try
+              if StripLength > 0 then
+                NewName := Copy(ExtractFileName(FileName), StripLength + 1, Length(FileName))
+              else
+                NewName := ExtractFileName(FileName);
+
+              Substitute(NewName, SubstChar, ReplaceStrings);
+
+              NewName := ExpandUNCFileName(Prefix + NewName);
+
+              if FileName = NewName then
+                ChangeFileExt(NewName, ProcessedExtension);
+              Process(pppState, FileName, NewName);
+            except
+              on e: Exception do
+                Writeln(Format('Error: %s %s', [e.Message, FileName]));
+            end;
+          end
+        else
+          Writeln('Could not find ', tmp);
+      finally
+        Files.Free;
+      end;
+    end;
+    Result := cp;
+  end;
+
+var
+  cp: PChar;
+begin
+  cp := ACommandLine;
+  StripLength := 0;
+  pppState := nil;
+  ReplaceStrings := nil;
+  try
+    pppState := TPppState.Create;
+    ReplaceStrings := TStringList.Create;
+    repeat
+      cp := HandleOptions(cp);
+      cp := HandleFiles(cp);
+    until cp^ = #0;
+  finally
+    pppState.Free;
+    ReplaceStrings.Free;
+  end;
+end;
+
+end.

Modified: trunk/jcl/devtools/jpp/jpp.dpr
===================================================================
--- trunk/jcl/devtools/jpp/jpp.dpr	2010-02-22 18:40:02 UTC (rev 3201)
+++ trunk/jcl/devtools/jpp/jpp.dpr	2010-02-22 18:42:06 UTC (rev 3202)
@@ -44,349 +44,13 @@
 program jpp;
 
 uses
-  {$IFDEF MSWINDOWS}
-  Windows,
-  {$ENDIF MSWINDOWS}
-  {$IFDEF HAS_UNIT_LIBC}
-  Libc,
-  {$ENDIF HAS_UNIT_LIBC}
-  Types,
   SysUtils,
-  Classes,
-  TypInfo,
-  JclFileUtils,
-  JclStrings,
-  JclStreams,
-  JclSysUtils,
   JppState in 'JppState.pas',
   JppParser in 'JppParser.pas',
-  JppLexer in 'JppLexer.pas';
+  JppLexer in 'JppLexer.pas',
+  JppMain in 'JppMain.pas';
 
-const
-  SubstChar = '_';
-  ProcessedExtension = '.jpp';
-  SWarningJppGenerated =
-    '{**************************************************************************************************}'#13#10 +
-    '{  WARNING:  JEDI preprocessor generated unit.  Do not edit.                                       }'#13#10 +
-    '{**************************************************************************************************}'#13#10;
-
-procedure Syntax;
-begin
-  Writeln(
-    'JEDI PreProcessor v. 2004-12-03'#10,
-    'Copyright (C) 2001 Barry Kelly'#10,
-    #10,
-    'Syntax:'#10,
-    '  ' + ParamStr(0) + ' [options] <input files>...'#10,
-    #10,
-    'Options:'#10,
-    '  -c'#9#9'Process conditional directives'#10,
-    '  -m'#9#9'Process macro directive'#10,
-    '  -v'#9#9'Process value directive'#10,
-    '  -C'#9#9'Strip comments'#10,
-    '  -fxxx'#9#9'Prefix xxx to filename'#10,
-    '  -h, -?'#9'This help'#10,
-    '  -i[x[,y...]]'#9'Process includes, except files x, y, ...'#10,
-    '  -pxxx'#9#9'Add xxx to include path'#10,
-    '  -dxxx'#9#9'Define xxx as a preprocessor conditional symbol'#10,
-    '  -uxxx'#9#9'Assume preprocessor conditional symbol xxx as not defined'#10,
-    '  -rx[,y...]'#9'Comma-separated list of strings to replace underscores'#10,
-    #9#9'in input file names with'#10,
-    //'  -x[n:]yyy'#9'Strip first n characters from file name; precede filename by prefix yyy'#10,
-    #10,
-    'When required to prevent the original file from being overwritten, '#10 +
-    'the processed file''s extension will be changed to ', ProcessedExtension, #10,
-    'If you have any suggestions or bug-reports, contact me at'#10,
-    'bar...@ho...'
-  );
-  Halt(2);
-end;
-
-procedure Process(AState: TPppState; const AOld, ANew: string);
 var
-  parse: TJppParser;
-  fsIn, fsOut: TStream;
-  ssIn: TJclAutoStream;
-  ssOut: TJclStringStream;
-  answer: string;
-begin
-  fsOut := nil;
-  parse := nil;
-  fsIn := nil;
-  ssIn := nil;
-  ssOut := nil;
-  AState.PushState;
-  try
-    fsIn := TFileStream.Create(AOld, fmOpenRead);
-    ssIn := TJclAutoStream.Create(fsIn);
-    parse := TJppParser.Create(ssIn.ReadString, AState);
-    answer := Format('%s'#13#10'%s', [SWarningJppGenerated, parse.Parse]);
-    fsOut := TFileStream.Create(ANew, fmCreate);
-    case ssIn.Encoding of
-      seAnsi:
-        ssOut := TJclAnsiStream.Create(fsOut);
-      seUTF8:
-        ssOut := TJclUTF8Stream.Create(fsOut);
-      seUTF16:
-        ssOut := TJclUTF16Stream.Create(fsOut);
-    else
-      WriteLn('Unknown encoding for file ' + AOld);
-      Abort;
-    end;
-    ssOut.WriteString(answer, 1, Length(answer));
-  finally
-    AState.PopState;
-    ssOut.Free;
-    fsOut.Free;
-    parse.Free;
-    ssIn.Free;
-    fsIn.Free;
-  end;
-end;
-
-procedure Substitute(var S: string; SubstChar: Char; SubstStrings: TStrings);
-var
-  I, J, K, N, Count: Integer;
-  Result, SubstString: string;
-  SubstDone: Boolean;
-begin
-  if SubstStrings = nil then
-    Exit;
-
-  Count := SubstStrings.Count;
-
-  if Count = 0 then
-    Exit;
-
-  SetLength(Result, Length(S) + Length(SubstStrings.Text)); // sufficient length
-  J := 1;
-  N := 0;
-  SubstDone := False;
-  for I := 1 to Length(S) do
-    if (S[I] = SubstChar) and not SubstDone then
-    begin
-      SubstString := SubstStrings[N];
-      for K := 1 to Length(SubstString) do
-      begin
-        Result[J] := SubstString[K];
-        Inc(J);
-      end;
-      Inc(N);
-      SubstDone := N = SubstStrings.Count;
-    end
-    else
-    begin
-      Result[J] := S[I];
-      Inc(J);
-    end;
-  SetLength(Result, J - 1);
-  S := Result;
-end;
-
-procedure Params(ACommandLine: PChar);
-var
-  pppState: TPppState;
-  StripLength: Integer; // RR
-  Prefix, ReplaceString: string; // RR
-  N: Integer;
-  ReplaceStrings: TStringList;
-
-  function ReadStringDoubleQuotedMaybe(cp: PChar; var AStr: string): PChar;
-  begin
-    { possibly quoted string }
-    Result := cp;
-    if Result^ = '"' then
-    begin
-      while (Result^ <> #0) and (Result^ <> '"') do
-        Inc(Result);
-      if Result^ = #0 then
-        raise Exception.Create('Unterminated string');
-      Inc(Result); // skip over final "
-      SetString(AStr, cp, Result - cp);
-    end
-    else
-    begin
-      while (Result^ <> #0) and not CharIsSpace(Result^) do
-        Inc(Result);
-      SetString(AStr, cp, Result - cp);
-    end;
-  end;
-
-  function HandleOptions(cp: PChar): PChar;
-
-    function CheckOpt(cp: PChar; AOpt: TPppOption): PChar;
-    begin
-      case cp^ of
-        '+':
-          begin
-            pppState.Options := pppState.Options + [AOpt];
-            Result := cp + 1;
-          end;
-        '-':
-          begin
-            pppState.Options := pppState.Options - [AOpt];
-            Result := cp + 1;
-          end;
-      else
-        pppState.Options := pppState.Options + [AOpt];
-        Result := cp;
-      end;
-    end;
-
-  var
-    tmp: string;
-    i: Integer;
-  begin
-    StrSkipChars(cp, CharIsWhiteSpace);
-
-    while cp^ = '-' do
-    begin
-      Inc(cp);
-
-      case cp^ of
-        'f', 'F': // RR
-          begin
-            Inc(cp);
-            cp := ReadStringDoubleQuotedMaybe(cp, Prefix);
-            Prefix := ExpandUNCFilename(Prefix);
-          end;
-
-        'h', 'H', '?':
-          Syntax;
-
-        'i', 'I':
-          begin
-            cp := ReadStringDoubleQuotedMaybe(CheckOpt(cp + 1, poProcessIncludes), tmp);
-            for i := 0 to ListItemCount(tmp, DirSeparator) - 1 do
-              pppState.AddFileToExclusionList(ListGetItem(tmp, DirSeparator, i));
-          end;
-
-        'c':
-          cp := CheckOpt(cp + 1, poProcessDefines);
-
-        'm':
-          cp := CheckOpt(cp + 1, poProcessMacros);
-
-        'v':
-          cp := CheckOpt(cp + 1, poProcessValues);
-
-        'C':
-          cp := CheckOpt(cp + 1, poStripComments);
-
-        'p', 'P':
-          begin
-            Inc(cp);
-            cp := ReadStringDoubleQuotedMaybe(cp, tmp);
-            pppState.AddToSearchPath(ExpandUNCFileName(tmp));
-          end;
-
-        'd':
-          begin
-            Inc(cp);
-            StrIdent(cp, tmp);
-            pppState.Define(tmp);
-          end;
-
-        'r':
-          begin
-            Inc(cp);
-            cp := ReadStringDoubleQuotedMaybe(cp, ReplaceString);
-            ReplaceStrings.CommaText := ReplaceString;
-          end;
-
-        'u': // RR
-          begin
-            Inc(cp);
-            StrIdent(cp, tmp);
-            pppState.Undef(tmp);
-          end;
-
-        'x', 'X': // RR
-          begin
-            Inc(cp);
-            cp := ReadStringDoubleQuotedMaybe(cp, Prefix);
-            Val(Prefix, StripLength, N);
-            if N > 1 then
-              Prefix := Copy(Prefix, N + 1, Length(Prefix));
-            Prefix := ExpandUNCFilename(Prefix);
-          end;
-
-      else
-        Syntax;
-      end;
-
-      StrSkipChars(cp, CharIsWhiteSpace);
-    end;
-    Result := cp;
-  end;
-
-  function HandleFiles(cp: PChar): PChar;
-  var
-    FileName, NewName, tmp: string;
-    Files: TStrings;
-    I: Integer;
-  begin
-    while (cp^ <> '-') and (cp^ <> #0) do
-    begin
-      cp := ReadStringDoubleQuotedMaybe(cp, tmp);
-      StrSkipChars(cp, CharIsWhiteSpace);
-
-      Files := TStringList.Create;
-      try
-        AdvBuildFileList( ExpandUNCFileName(tmp), faAnyFile, Files, amAny);
-
-        if Files.Count > 0 then
-          for I := 0 to Files.Count - 1 do
-          begin
-            FileName := Files.Strings[I];
-            try
-              if StripLength > 0 then
-                NewName := Copy(ExtractFileName(FileName), StripLength + 1, Length(FileName))
-              else
-                NewName := ExtractFileName(FileName);
-
-              Substitute(NewName, SubstChar, ReplaceStrings);
-
-              NewName := ExpandUNCFileName(Prefix + NewName);
-
-              if FileName = NewName then
-                ChangeFileExt(NewName, ProcessedExtension);
-              Process(pppState, FileName, NewName);
-            except
-              on e: Exception do
-                Writeln(Format('Error: %s %s', [e.Message, FileName]));
-            end;
-          end
-        else
-          Writeln('Could not find ', tmp);
-      finally
-        Files.Free;
-      end;
-    end;
-    Result := cp;
-  end;
-
-var
-  cp: PChar;
-begin
-  cp := ACommandLine;
-  StripLength := 0;
-  pppState := nil;
-  ReplaceStrings := nil;
-  try
-    pppState := TPppState.Create;
-    ReplaceStrings := TStringList.Create;
-    repeat
-      cp := HandleOptions(cp);
-      cp := HandleFiles(cp);
-    until cp^ = #0;
-  finally
-    pppState.Free;
-    ReplaceStrings.Free;
-  end;
-end;
-
-var
   CommandLine: string;
   i: Integer;
 begin


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3201] trunk/jcl/devtools/jpp

From: <ou...@us...> - 2010-02-22 18:40:11

Revision: 3201
          http://jcl.svn.sourceforge.net/jcl/?rev=3201&view=rev
Author:   outchy
Date:     2010-02-22 18:40:02 +0000 (Mon, 22 Feb 2010)

Log Message:
-----------
Add support for $JPPSETSTRVALUE, $JPPSETBOOLVALUE, $JPPSETINTVALUE directives.
Minor changes in JppState.pas.

Modified Paths:
--------------
    trunk/jcl/devtools/jpp/JppLexer.pas
    trunk/jcl/devtools/jpp/JppParser.pas
    trunk/jcl/devtools/jpp/JppState.pas

Modified: trunk/jcl/devtools/jpp/JppLexer.pas
===================================================================
--- trunk/jcl/devtools/jpp/JppLexer.pas	2010-02-22 18:36:33 UTC (rev 3200)
+++ trunk/jcl/devtools/jpp/JppLexer.pas	2010-02-22 18:40:02 UTC (rev 3201)
@@ -63,7 +63,8 @@
   TJppToken = (ptEof, ptComment, ptText, ptEol,
     ptDefine, ptUndef, ptIfdef, ptIfndef, ptIfopt, ptElse, ptEndif,
     ptInclude, ptJppDefineMacro, ptJppExpandMacro, ptJppUndefMacro,
-    ptJppStrValue, ptJppIntValue, ptJppBoolValue, ptJppLoop);
+    ptJppGetStrValue, ptJppGetIntValue, ptJppGetBoolValue,
+    ptJppSetStrValue, ptJppSetIntValue, ptJppSetBoolValue, ptJppLoop);
 
   EJppLexerError = class(Exception);
 
@@ -134,9 +135,15 @@
   AddToken('jppdefinemacro', ptjppDefineMacro);
   AddToken('jppexpandmacro', ptJppExpandMacro);
   AddToken('jppundefmacro', ptJppUndefMacro);
-  AddToken('jppstrvalue', ptJppStrValue);
-  AddToken('jppintvalue', ptJppIntValue);
-  AddToken('jppboolvalue', ptJppBoolValue);
+  AddToken('jppstrvalue', ptJppGetStrValue);   // backward compatibility
+  AddToken('jppintvalue', ptJppGetIntValue);   // backward compatibility
+  AddToken('jppboolvalue', ptJppGetBoolValue); // backward compatibility
+  AddToken('jppgetstrvalue', ptJppGetStrValue);
+  AddToken('jppgetintvalue', ptJppGetIntValue);
+  AddToken('jppgetboolvalue', ptJppGetBoolValue);
+  AddToken('jppsetstrvalue', ptJppSetStrValue);
+  AddToken('jppsetintvalue', ptJppSetIntValue);
+  AddToken('jppsetboolvalue', ptJppSetBoolValue);
   AddToken('jpploop', ptJppLoop);
 
   FBuf := ABuffer;
@@ -210,9 +217,12 @@
         ptUndef,
         ptIfdef,
         ptIfndef,
-        ptJppStrValue,
-        ptJppIntValue,
-        ptJppBoolValue:
+        ptJppGetStrValue,
+        ptJppGetIntValue,
+        ptJppGetBoolValue,
+        ptJppSetStrValue,
+        ptJppSetIntValue,
+        ptJppSetBoolValue:
           begin
             BPos := APos;
             StrSkipChars(BPos, CharIsWhiteSpace);

Modified: trunk/jcl/devtools/jpp/JppParser.pas
===================================================================
--- trunk/jcl/devtools/jpp/JppParser.pas	2010-02-22 18:36:33 UTC (rev 3200)
+++ trunk/jcl/devtools/jpp/JppParser.pas	2010-02-22 18:40:02 UTC (rev 3201)
@@ -85,10 +85,13 @@
     procedure ParseExpandMacro;
     procedure ParseUndefMacro;
 
-    procedure ParseBoolValue;
-    procedure ParseIntValue;
+    procedure ParseGetBoolValue;
+    procedure ParseGetIntValue;
+    procedure ParseGetStrValue;
     procedure ParseLoop;
-    procedure ParseStrValue;
+    procedure ParseSetBoolValue;
+    procedure ParseSetIntValue;
+    procedure ParseSetStrValue;
 
     // same as ParseText, but throws result away
     procedure Skip;
@@ -116,7 +119,7 @@
 implementation
 
 uses
-  JclBase, JclStrings, JclStreams;
+  JclBase, JclStrings, JclStreams, JclSysUtils;
   
 {$IFDEF MSWINDOWS}
 const
@@ -296,9 +299,12 @@
           ptJppDefineMacro,
           ptJppExpandMacro,
           ptJppUndefMacro,
-          ptJppStrValue,
-          ptJppIntValue,
-          ptJppBoolValue,
+          ptJppGetStrValue,
+          ptJppGetIntValue,
+          ptJppGetBoolValue,
+          ptJppSetStrValue,
+          ptJppSetIntValue,
+          ptJppSetBoolValue,
           ptJppLoop:
             begin
               Recurse := True;
@@ -432,9 +438,12 @@
     ptJppDefineMacro,
     ptJppExpandMacro,
     ptJppUndefMacro,
-    ptJppStrValue,
-    ptJppIntValue,
-    ptJppBoolValue,
+    ptJppGetStrValue,
+    ptJppGetIntValue,
+    ptJppGetBoolValue,
+    ptJppSetStrValue,
+    ptJppSetIntValue,
+    ptJppSetBoolValue,
     ptJppLoop:
       FAllWhiteSpaceIn := False;
     ptInclude:
@@ -621,7 +630,7 @@
   NextToken;
 end;
 
-procedure TJppParser.ParseStrValue;
+procedure TJppParser.ParseGetStrValue;
 var
   Name: string;
 begin
@@ -630,7 +639,7 @@
   NextToken;
 end;
 
-procedure TJppParser.ParseIntValue;
+procedure TJppParser.ParseGetIntValue;
 var
   Name: string;
 begin
@@ -639,7 +648,7 @@
   NextToken;
 end;
 
-procedure TJppParser.ParseBoolValue;
+procedure TJppParser.ParseGetBoolValue;
 var
   Name: string;
 begin
@@ -683,6 +692,81 @@
   NextToken;
 end;
 
+procedure TJppParser.ParseSetStrValue;
+var
+  I, J: Integer;
+  Text, Name, Value: string;
+begin
+  I := 1;
+  Text := Lexer.RawComment;
+  while (I <= Length(Text)) and not CharIsWhiteSpace(Text[I]) do
+    Inc(I);
+  while (I <= Length(Text)) and CharIsWhiteSpace(Text[I]) do
+    Inc(I);
+  J := I;
+  while (J <= Length(Text)) and CharIsValidIdentifierLetter(Text[J]) do
+    Inc(J);
+  Name := Copy(Text, I, J - I);
+  while (J <= Length(Text)) and CharIsWhiteSpace(Text[J]) do
+    Inc(J);
+  I := Length(Text);
+  if Text[I] = ')' then
+    Dec(I);
+  Value := Copy(Text, J, I - J);
+  State.StringValues[Name] := Value;
+  NextToken;
+end;
+
+procedure TJppParser.ParseSetIntValue;
+var
+  I, J: Integer;
+  Text, Name, Value: string;
+begin
+  I := 1;
+  Text := Lexer.RawComment;
+  while (I <= Length(Text)) and not CharIsWhiteSpace(Text[I]) do
+    Inc(I);
+  while (I <= Length(Text)) and CharIsWhiteSpace(Text[I]) do
+    Inc(I);
+  J := I;
+  while (J <= Length(Text)) and CharIsValidIdentifierLetter(Text[J]) do
+    Inc(J);
+  Name := Copy(Text, I, J - I);
+  while (J <= Length(Text)) and CharIsWhiteSpace(Text[J]) do
+    Inc(J);
+  I := Length(Text);
+  if Text[I] = ')' then
+    Dec(I);
+  Value := Copy(Text, J, I - J);
+  State.IntegerValues[Name] := StrToInt(Value);
+  NextToken;
+end;
+
+procedure TJppParser.ParseSetBoolValue;
+var
+  I, J: Integer;
+  Text, Name, Value: string;
+begin
+  I := 1;
+  Text := Lexer.RawComment;
+  while (I <= Length(Text)) and not CharIsWhiteSpace(Text[I]) do
+    Inc(I);
+  while (I <= Length(Text)) and CharIsWhiteSpace(Text[I]) do
+    Inc(I);
+  J := I;
+  while (J <= Length(Text)) and CharIsValidIdentifierLetter(Text[J]) do
+    Inc(J);
+  Name := Copy(Text, I, J - I);
+  while (J <= Length(Text)) and CharIsWhiteSpace(Text[J]) do
+    Inc(J);
+  I := Length(Text);
+  if Text[I] = ')' then
+    Dec(I);
+  Value := Copy(Text, J, I - J);
+  State.BoolValues[Name] := StrToBoolean(Value);
+  NextToken;
+end;
+
 procedure TJppParser.ParseText;
 
   procedure AddRawComment;
@@ -749,15 +833,27 @@
         else
           AddRawComment;
 
-      ptJppStrValue, ptJppIntValue, ptJppBoolValue, ptJppLoop:
+      ptJppGetStrValue,
+      ptJppGetIntValue,
+      ptJppGetBoolValue,
+      ptJppSetStrValue,
+      ptJppSetIntValue,
+      ptJppSetBoolValue,
+      ptJppLoop:
         if poProcessValues in State.Options then
           case Lexer.CurrTok of
-            ptJppStrValue:
-              ParseStrValue;
-            ptJppIntValue:
-              ParseIntValue;
-            ptJppBoolValue:
-              ParseBoolValue;
+            ptJppGetStrValue:
+              ParseGetStrValue;
+            ptJppGetIntValue:
+              ParseGetIntValue;
+            ptJppGetBoolValue:
+              ParseGetBoolValue;
+            ptJppSetStrValue:
+              ParseSetStrValue;
+            ptJppSetIntValue:
+              ParseSetIntValue;
+            ptJppSetBoolValue:
+              ParseSetBoolValue;
             ptJppLoop:
               ParseLoop;
           end

Modified: trunk/jcl/devtools/jpp/JppState.pas
===================================================================
--- trunk/jcl/devtools/jpp/JppState.pas	2010-02-22 18:36:33 UTC (rev 3200)
+++ trunk/jcl/devtools/jpp/JppState.pas	2010-02-22 18:40:02 UTC (rev 3201)
@@ -355,7 +355,7 @@
     PI := GetPropInfo(Self, ASymbol);
     if Assigned(PI) then
     begin
-      PV := GetPropValue(Self, ASymbol);
+      PV := GetPropValue(Self, PI);
       if Boolean(PV) then
         Result := ttDefined
       else
@@ -392,8 +392,8 @@
   Result := (FStateStack.Peek as TSimplePppStateItem).SearchPath;
 end;
 
-procedure TPppState.InternalPushState(const ExcludedFiles,
-  SearchPath: IJclStrList; const Macros: IJclStrIntfMap; const Defines: IJclStrMap);
+procedure TPppState.InternalPushState(const ExcludedFiles, SearchPath: IJclStrList;
+  const Macros: IJclStrIntfMap; const Defines: IJclStrMap);
 var
   AStateItem: TSimplePppStateItem;
 begin
@@ -462,10 +462,8 @@
 var
   ADefines: IJclStrMap;
   ASymbolNames: IJclStrIterator;
-  Found: Boolean;
   PI: PPropInfo;
 begin
-  Found := False;
   ADefines := InternalPeekDefines;
   ASymbolNames := ADefines.KeySet.First;
   while ASymbolNames.HasNext do
@@ -473,11 +471,10 @@
     if JclStrings.StrSame(ASymbolNames.Next, ASymbol) then
     begin
       ADefines.Items[ASymbolNames.GetString] := TObject(Value);
-      Found := True;
-      Break;
+      Exit;
     end;
   end;
-  if (not Found) and (Value <> ttUnknown) then
+  if Value <> ttUnknown then
   begin
     PI := GetPropInfo(Self, ASymbol);
     if Assigned(PI) then
@@ -486,10 +483,10 @@
         SetPropValue(Self, PI, True)
       else
         SetPropValue(Self, PI, False);
+      Exit;
     end;
   end;
-  if not Found then
-    ADefines.Items[ASymbol] := TObject(Value);
+  ADefines.Items[ASymbol] := TObject(Value);
 end;
 
 procedure TPppState.SetIntegerValue(const Name: string; Value: Integer);


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3200] trunk/jcl/experts/repository/ExceptionDialog/ CreateStdDialogs.dpr

From: <ou...@us...> - 2010-02-22 18:36:40

Revision: 3200
          http://jcl.svn.sourceforge.net/jcl/?rev=3200&view=rev
Author:   outchy
Date:     2010-02-22 18:36:33 +0000 (Mon, 22 Feb 2010)

Log Message:
-----------
missing quotes resulting in invalid generated file.

Modified Paths:
--------------
    trunk/jcl/experts/repository/ExceptionDialog/CreateStdDialogs.dpr

Modified: trunk/jcl/experts/repository/ExceptionDialog/CreateStdDialogs.dpr
===================================================================
--- trunk/jcl/experts/repository/ExceptionDialog/CreateStdDialogs.dpr	2010-02-22 17:24:06 UTC (rev 3199)
+++ trunk/jcl/experts/repository/ExceptionDialog/CreateStdDialogs.dpr	2010-02-22 18:36:33 UTC (rev 3200)
@@ -87,7 +87,7 @@
       Params.HookDll := True;
       Params.LogFile := True;
       Params.LogSaveDialog := True;
-      Params.LogFileName := 'filename.log';
+      Params.LogFileName := '''filename.log''';
       Params.OSInfo := True;
       Params.ModuleList := True;
       Params.ActiveControls := True;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3199] trunk/jcl/experts/repository/ExceptionDialog/ Templates/ExceptDlg.Delphi32.pas

From: <ou...@us...> - 2010-02-22 17:24:13

Revision: 3199
          http://jcl.svn.sourceforge.net/jcl/?rev=3199&view=rev
Author:   outchy
Date:     2010-02-22 17:24:06 +0000 (Mon, 22 Feb 2010)

Log Message:
-----------
Reworked some old relics before the exception dialogs are generated by JPP.

Modified Paths:
--------------
    trunk/jcl/experts/repository/ExceptionDialog/Templates/ExceptDlg.Delphi32.pas

Modified: trunk/jcl/experts/repository/ExceptionDialog/Templates/ExceptDlg.Delphi32.pas
===================================================================
--- trunk/jcl/experts/repository/ExceptionDialog/Templates/ExceptDlg.Delphi32.pas	2010-02-22 17:11:16 UTC (rev 3198)
+++ trunk/jcl/experts/repository/ExceptionDialog/Templates/ExceptDlg.Delphi32.pas	2010-02-22 17:24:06 UTC (rev 3199)
@@ -281,7 +281,7 @@
   with TSaveDialog.Create(Self) do
   try
     DefaultExt := '.log';
-    FileName := {$JPPEXPANDMACRO QUOTE}{$JPPSTRVALUE LogFileName}{$JPPEXPANDMACRO QUOTE};
+    FileName := {$JPPSTRVALUE LogFileName};
     Filter := 'Log Files (*.log)|*.log|All files (*.*)|*.*';
     Title := 'Save log as...';
     Options := [ofHideReadOnly,ofPathMustExist,ofNoReadOnlyReturn,ofEnableSizing,ofDontAddToRecent];
@@ -309,9 +309,9 @@
   try
     CreateReport;
 {$IFDEF LogFile}
-{$IFDEF AutoSaveWorkingDirectory}    SaveToLogFile(%StrValue LogFileName);{$ENDIF}
-{$IFDEF AutoSaveApplicationDirectory}    SaveToLogFile(PathAddSeparator(ExtractFilePath(Application.ExeName)) + %StrValue LogFileName);{$ENDIF}
-{$IFDEF AutoSaveDesktopDirectory}    SaveToLogFile(PathAddSeparator(GetDesktopFolder) + %StrValue LogFileName);{$ENDIF}
+{$IFDEF AutoSaveWorkingDirectory}    SaveToLogFile({$JPPSTRVALUE LogFileName});{$ENDIF}
+{$IFDEF AutoSaveApplicationDirectory}    SaveToLogFile(PathAddSeparator(ExtractFilePath(Application.ExeName)) + {$JPPSTRVALUE LogFileName});{$ENDIF}
+{$IFDEF AutoSaveDesktopDirectory}    SaveToLogFile(PathAddSeparator(GetDesktopFolder) + {$JPPSTRVALUE LogFileName});{$ENDIF}
 {$ENDIF}
     DetailsMemo.SelStart := 0;
     SendMessage(DetailsMemo.Handle, EM_SCROLLCARET, 0, 0);


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3198] trunk/jcl

From: <ou...@us...> - 2010-02-22 17:11:25

Revision: 3198
          http://jcl.svn.sourceforge.net/jcl/?rev=3198&view=rev
Author:   outchy
Date:     2010-02-22 17:11:16 +0000 (Mon, 22 Feb 2010)

Log Message:
-----------
reworked JPP repeat directive in a way close to pascal for loops.

Modified Paths:
--------------
    trunk/jcl/devtools/jpp/JppLexer.pas
    trunk/jcl/devtools/jpp/JppParser.pas
    trunk/jcl/devtools/jpp/JppState.pas
    trunk/jcl/experts/repository/ExceptionDialog/JclOtaExcDlgParams.pas
    trunk/jcl/experts/repository/ExceptionDialog/Templates/ExceptDlg.Delphi32.pas

Modified: trunk/jcl/devtools/jpp/JppLexer.pas
===================================================================
--- trunk/jcl/devtools/jpp/JppLexer.pas	2010-02-22 16:01:27 UTC (rev 3197)
+++ trunk/jcl/devtools/jpp/JppLexer.pas	2010-02-22 17:11:16 UTC (rev 3198)
@@ -63,7 +63,7 @@
   TJppToken = (ptEof, ptComment, ptText, ptEol,
     ptDefine, ptUndef, ptIfdef, ptIfndef, ptIfopt, ptElse, ptEndif,
     ptInclude, ptJppDefineMacro, ptJppExpandMacro, ptJppUndefMacro,
-    ptJppStrValue, ptJppIntValue, ptJppBoolValue, ptJppRepeat, ptJppRepeatStrValue);
+    ptJppStrValue, ptJppIntValue, ptJppBoolValue, ptJppLoop);
 
   EJppLexerError = class(Exception);
 
@@ -135,10 +135,9 @@
   AddToken('jppexpandmacro', ptJppExpandMacro);
   AddToken('jppundefmacro', ptJppUndefMacro);
   AddToken('jppstrvalue', ptJppStrValue);
-  AddToken('jpprepeatstrvalue', ptJppRepeatStrValue);
   AddToken('jppintvalue', ptJppIntValue);
   AddToken('jppboolvalue', ptJppBoolValue);
-  AddToken('jpprepeat', ptJppRepeat);
+  AddToken('jpploop', ptJppLoop);
 
   FBuf := ABuffer;
   Reset;
@@ -213,8 +212,7 @@
         ptIfndef,
         ptJppStrValue,
         ptJppIntValue,
-        ptJppBoolValue,
-        ptJppRepeatStrValue:
+        ptJppBoolValue:
           begin
             BPos := APos;
             StrSkipChars(BPos, CharIsWhiteSpace);

Modified: trunk/jcl/devtools/jpp/JppParser.pas
===================================================================
--- trunk/jcl/devtools/jpp/JppParser.pas	2010-02-22 16:01:27 UTC (rev 3197)
+++ trunk/jcl/devtools/jpp/JppParser.pas	2010-02-22 17:11:16 UTC (rev 3198)
@@ -67,10 +67,9 @@
     FSkipLevel: Integer;
     FAllWhiteSpaceIn: Boolean;
     FAllWhiteSpaceOut: Boolean;
-    FRepeatIndex: Integer;
     procedure RemoveOrphanedLineBreaks;
   protected
-    procedure AddResult(const S: string);
+    procedure AddResult(const S: string; FixIndent: Boolean = False);
     function IsExcludedInclude(const FileName: string): Boolean;
 
     procedure NextToken;
@@ -88,9 +87,8 @@
 
     procedure ParseBoolValue;
     procedure ParseIntValue;
-    procedure ParseRepeat;
+    procedure ParseLoop;
     procedure ParseStrValue;
-    procedure ParseRepeatStrValue;
 
     // same as ParseText, but throws result away
     procedure Skip;
@@ -264,7 +262,6 @@
   FState := APppState;
   FTriState := ttUnknown;
   FState.Undef('PROTOTYPE');
-  FRepeatIndex := -1;
 end;
 
 destructor TJppParser.Destroy;
@@ -273,16 +270,115 @@
   inherited;
 end;
 
-procedure TJppParser.AddResult(const S: string);
+procedure TJppParser.AddResult(const S: string; FixIndent: Boolean);
+var
+  I, J: Integer;
+  LinePrefix, AResult: string;
+  TempMemoryStream: TMemoryStream;
+  TempStringStream: TJclAutoStream;
+  TempLexer: TJppLexer;
+  TempParser: TJppParser;
+  Lines: TStrings;
+  Recurse: Boolean;
 begin
+  AResult := S;
+  // recurse macro expanding
+  if StrIPos('$JPP', AResult) > 0 then
+  begin
+    Recurse := False;
+    TempLexer := TJppLexer.Create(AResult);
+    try
+      while True do
+      begin
+        case TempLexer.CurrTok of
+          ptEof:
+            Break;
+          ptJppDefineMacro,
+          ptJppExpandMacro,
+          ptJppUndefMacro,
+          ptJppStrValue,
+          ptJppIntValue,
+          ptJppBoolValue,
+          ptJppLoop:
+            begin
+              Recurse := True;
+              Break;
+            end;
+        end;
+        TempLexer.NextTok;
+      end;
+    finally
+      TempLexer.Free;
+    end;
+    if Recurse then
+    begin
+      TempMemoryStream := TMemoryStream.Create;
+      try
+        TempStringStream := TJclAutoStream.Create(TempMemoryStream);
+        try
+          TempStringStream.WriteString(AResult, 1, Length(AResult));
+          TempStringStream.Seek(0, soBeginning);
+          TempParser := TJppParser.Create(TempStringStream.ReadString, State);
+          try
+            AResult := TempParser.Parse;
+          finally
+            TempParser.Free;
+          end;
+        finally
+          TempStringStream.Free;
+        end;
+      finally
+        TempMemoryStream.Free;
+      end;
+    end;
+  end;
+  if FixIndent then
+  begin
+    // find the number of white space at the beginning of the current line (indentation level)
+    I := FResultLen + 1;
+    while (I > 1) and not CharIsReturn(FResult[I - 1]) do
+     Dec(I);
+    J := I;
+    while (J <= FResultLen) and CharIsWhiteSpace(FResult[J]) do
+      Inc(J);
+    LinePrefix := StrRepeat(NativeSpace, J - I);
+
+    Lines := TStringList.Create;
+    try
+      StrToStrings(AResult, NativeLineBreak, Lines);
+      // remove first empty lines
+      while Lines.Count > 0 do
+      begin
+        if Lines.Strings[0] = '' then
+          Lines.Delete(0)
+        else
+          Break;
+      end;
+      // remove last empty lines
+      for I := Lines.Count - 1 downto 0 do
+      begin
+        if Lines.Strings[I] = '' then
+          Lines.Delete(I)
+        else
+          Break;
+      end;
+      // fix line offsets
+      if LinePrefix <> '' then
+        for I := 1 to Lines.Count - 1 do
+          Lines.Strings[I] := LinePrefix + Lines.Strings[I];
+      AResult := StringsToStr(Lines, NativeLineBreak);
+    finally
+      Lines.Free;
+    end;
+  end;
   if FSkipLevel > 0 then
     Exit;
-  while FResultLen + Length(S) > Length(FResult) do
+  while FResultLen + Length(AResult) > Length(FResult) do
     SetLength(FResult, Length(FResult) * 2);
-  Move(S[1], FResult[FResultLen + 1], Length(S) * SizeOf(Char));
+  Move(AResult[1], FResult[FResultLen + 1], Length(AResult) * SizeOf(Char));
   if FAllWhiteSpaceOut then
     FAllWhiteSpaceOut := AllWhiteSpace(@FResult[FLineBreakPos]);
-  Inc(FResultLen, Length(S));
+  Inc(FResultLen, Length(AResult));
 end;
 
 function TJppParser.IsExcludedInclude(const FileName: string): Boolean;
@@ -339,8 +435,7 @@
     ptJppStrValue,
     ptJppIntValue,
     ptJppBoolValue,
-    ptJppRepeat,
-    ptJppRepeatStrValue:
+    ptJppLoop:
       FAllWhiteSpaceIn := False;
     ptInclude:
       FAllWhiteSpaceIn := IsExcludedInclude(Lexer.TokenAsString);
@@ -449,109 +544,15 @@
 
 procedure TJppParser.ParseExpandMacro;
 var
-  MacroText, MacroName, AResult, LinePrefix: string;
+  MacroText, MacroName, AResult: string;
   ParamNames: TDynStringArray;
-  I, J: Integer;
-  TempMemoryStream: TMemoryStream;
-  TempStringStream: TJclAutoStream;
-  TempLexer: TJppLexer;
-  TempParser: TJppParser;
-  Recurse: Boolean;
-  Lines: TStrings;
 begin
   MacroText := Lexer.TokenAsString;
   // expand the macro
   ParseMacro(MacroText, MacroName, ParamNames, False);
   AResult := State.ExpandMacro(MacroName, ParamNames);
-  // recurse macro expanding
-  if StrIPos('$JPP', AResult) > 0 then
-  begin
-    Recurse := False;
-    TempLexer := TJppLexer.Create(AResult);
-    try
-      while True do
-      begin
-        case TempLexer.CurrTok of
-          ptEof:
-            Break;
-          ptJppDefineMacro,
-          ptJppExpandMacro,
-          ptJppUndefMacro,
-          ptJppStrValue,
-          ptJppIntValue,
-          ptJppBoolValue,
-          ptJppRepeat,
-          ptJppRepeatStrValue:
-            begin
-              Recurse := True;
-              Break;
-            end;
-        end;
-        TempLexer.NextTok;
-      end;
-    finally
-      TempLexer.Free;
-    end;
-    if Recurse then
-    begin
-      TempMemoryStream := TMemoryStream.Create;
-      try
-        TempStringStream := TJclAutoStream.Create(TempMemoryStream);
-        try
-          TempStringStream.WriteString(AResult, 1, Length(AResult));
-          TempStringStream.Seek(0, soBeginning);
-          TempParser := TJppParser.Create(TempStringStream.ReadString, State);
-          try
-            AResult := TempParser.Parse;
-          finally
-            TempParser.Free;
-          end;
-        finally
-          TempStringStream.Free;
-        end;
-      finally
-        TempMemoryStream.Free;
-      end;
-    end;
-  end;
-  // find the number of white space at the beginning of the current line (indentation level)
-  I := FResultLen + 1;
-  while (I > 1) and not CharIsReturn(FResult[I - 1]) do
-    Dec(I);
-  J := I;
-  while (J <= FResultLen) and CharIsWhiteSpace(FResult[J]) do
-    Inc(J);
-  LinePrefix := StrRepeat(NativeSpace, J - I);
-
-  Lines := TStringList.Create;
-  try
-    StrToStrings(AResult, NativeLineBreak, Lines);
-    // remove first empty lines
-    while Lines.Count > 0 do
-    begin
-      if Lines.Strings[0] = '' then
-        Lines.Delete(0)
-      else
-        Break;
-    end;
-    // remove last empty lines
-    for I := Lines.Count - 1 downto 0 do
-    begin
-      if Lines.Strings[I] = '' then
-        Lines.Delete(I)
-      else
-        Break;
-    end;
-    // fix line offsets
-    if LinePrefix <> '' then
-      for I := 1 to Lines.Count - 1 do
-        Lines.Strings[I] := LinePrefix + Lines.Strings[I];
-    AResult := StringsToStr(Lines, NativeLineBreak);
-  finally
-    Lines.Free;
-  end;
   // add result to buffer
-  AddResult(AResult);
+  AddResult(AResult, True);
   NextToken;
 end;
 
@@ -647,52 +648,39 @@
   NextToken;
 end;
 
-procedure TJppParser.ParseRepeat;
+procedure TJppParser.ParseLoop;
 var
-  I, J: Integer;
-  RepeatText, CountName: string;
+  I, J, RepeatIndex, RepeatCount: Integer;
+  RepeatText, IndexName, CountName: string;
 begin
-  if FRepeatIndex = -1 then
-  begin
-    I := 1;
-    RepeatText := Lexer.RawComment;
-    while (I <= Length(RepeatText)) and not CharIsWhiteSpace(RepeatText[I]) do
-      Inc(I);
-    while (I <= Length(RepeatText)) and CharIsWhiteSpace(RepeatText[I]) do
-      Inc(I);
-    J := I;
-    while (J <= Length(RepeatText)) and CharIsValidIdentifierLetter(RepeatText[J]) do
-      Inc(J);
-    CountName := Copy(RepeatText, I, J - I);
-    I := Length(RepeatText);
-    if RepeatText[I] = ')' then
-      Dec(I);
-    RepeatText := Copy(RepeatText, J, I - J);
-    FRepeatIndex := State.IntegerValues[CountName];
-    while FRepeatIndex > 0 do
-    begin
-      Dec(FRepeatIndex);
-      AddResult(RepeatText);
-    end;
-    FRepeatIndex := -1;
-    NextToken;
-  end
-  else
-    raise EPppParserError.Create('Nested repeat');
-end;
+  I := 1;
+  RepeatText := Lexer.RawComment;
+  while (I <= Length(RepeatText)) and not CharIsWhiteSpace(RepeatText[I]) do
+    Inc(I);
+  while (I <= Length(RepeatText)) and CharIsWhiteSpace(RepeatText[I]) do
+    Inc(I);
+  J := I;
+  while (J <= Length(RepeatText)) and CharIsValidIdentifierLetter(RepeatText[J]) do
+    Inc(J);
+  IndexName := Copy(RepeatText, I, J - I);
+  while (J <= Length(RepeatText)) and CharIsWhiteSpace(RepeatText[J]) do
+    Inc(J);
+  I := J;
+  while (J <= Length(RepeatText)) and CharIsValidIdentifierLetter(RepeatText[I]) do
+    Inc(I);
+  CountName := Copy(RepeatText, J, I - J);
 
-procedure TJppParser.ParseRepeatStrValue;
-var
-  Name: string;
-begin
-  if FRepeatIndex > -1 then
+  J := Length(RepeatText);
+  if RepeatText[J] = ')' then
+    Dec(J);
+  RepeatText := Copy(RepeatText, I, J - I);
+  RepeatCount := State.IntegerValues[CountName];
+  for RepeatIndex := 0 to RepeatCount - 1 do
   begin
-    Name := Lexer.TokenAsString;
-    AddResult(State.StringsValues[Name].Strings[FRepeatIndex]);
-    NextToken;
-  end
-  else
-    raise EPppParserError.Create('JPPREPEATSTRVALUE outside JPPREPEAT');
+    State.IntegerValues[IndexName] := RepeatIndex;
+    AddResult(RepeatText);
+  end;
+  NextToken;
 end;
 
 procedure TJppParser.ParseText;
@@ -761,7 +749,7 @@
         else
           AddRawComment;
 
-      ptJppStrValue, ptJppIntValue, ptJppBoolValue, ptJppRepeat, ptJppRepeatStrValue:
+      ptJppStrValue, ptJppIntValue, ptJppBoolValue, ptJppLoop:
         if poProcessValues in State.Options then
           case Lexer.CurrTok of
             ptJppStrValue:
@@ -770,10 +758,8 @@
               ParseIntValue;
             ptJppBoolValue:
               ParseBoolValue;
-            ptJppRepeat:
-              ParseRepeat;
-            ptJppRepeatStrValue:
-              ParseRepeatStrValue;
+            ptJppLoop:
+              ParseLoop;
           end
         else
           AddRawComment;

Modified: trunk/jcl/devtools/jpp/JppState.pas
===================================================================
--- trunk/jcl/devtools/jpp/JppState.pas	2010-02-22 16:01:27 UTC (rev 3197)
+++ trunk/jcl/devtools/jpp/JppState.pas	2010-02-22 17:11:16 UTC (rev 3198)
@@ -66,17 +66,18 @@
   TPppProvider = class(TPersistent)
   protected
     function GetBoolValue(const Name: string): Boolean; virtual; abstract;
+    function GetDefine(const ASymbol: string): TTriState; virtual; abstract;
+    function GetIntegerValue(const Name: string): Integer; virtual; abstract;
     function GetStringValue(const Name: string): string; virtual; abstract;
-    function GetIntegerValue(const Name: string): Integer; virtual; abstract;
-    function GetStringsValue(const Name: string): TStrings; virtual; abstract;
-    function GetDefine(const ASymbol: string): TTriState; virtual; abstract;
+    procedure SetBoolValue(const Name: string; Value: Boolean); virtual; abstract;
     procedure SetDefine(const ASymbol: string; const Value: TTriState); virtual; abstract;
+    procedure SetIntegerValue(const Name: string; Value: Integer); virtual; abstract;
+    procedure SetStringValue(const Name, Value: string); virtual; abstract;
   public
     property Defines[const ASymbol: string]: TTriState read GetDefine write SetDefine;
-    property BoolValues[const Name: string]: Boolean read GetBoolValue;
-    property StringValues[const Name: string]: string read GetStringValue;
-    property IntegerValues[const Name: string]: Integer read GetIntegerValue;
-    property StringsValues[const Name: string]: TStrings read GetStringsValue;
+    property BoolValues[const Name: string]: Boolean read GetBoolValue write SetBoolValue;
+    property StringValues[const Name: string]: string read GetStringValue write SetStringValue;
+    property IntegerValues[const Name: string]: Integer read GetIntegerValue write SetIntegerValue;
   end;
 
   TPppState = class(TPppProvider)
@@ -93,12 +94,14 @@
     function GetOptions: TPppOptions;
     procedure SetOptions(AOptions: TPppOptions);
 
+    function GetBoolValue(const Name: string): Boolean; override;
     function GetDefine(const ASymbol: string): TTriState; override;
+    function GetIntegerValue(const Name: string): Integer; override;
+    function GetStringValue(const Name: string): string; override;
+    procedure SetBoolValue(const Name: string; Value: Boolean); override;
     procedure SetDefine(const ASymbol: string; const Value: TTriState); override;
-    function GetBoolValue(const Name: string): Boolean; override;
-    function GetStringValue(const Name: string): string; override;
-    function GetIntegerValue(const Name: string): Integer; override;
-    function GetStringsValue(const Name: string): TStrings; override;
+    procedure SetIntegerValue(const Name: string; Value: Integer); override;
+    procedure SetStringValue(const Name, Value: string); override;
   public
     constructor Create;
     destructor Destroy; override;
@@ -316,17 +319,6 @@
   Result := Integer(VariantValue);
 end;
 
-function TPppState.GetStringsValue(const Name: string): TStrings;
-var
-  Instance: TObject;
-begin
-  Instance := TObject(GetOrdProp(Self, Name));
-  if Instance is TStrings then
-    Result := TStrings(Instance)
-  else
-    Result := nil;
-end;
-
 function TPppState.GetStringValue(const Name: string): string;
 var
   VariantValue: Variant;
@@ -457,12 +449,21 @@
   FOptions := AOptions;
 end;
 
+procedure TPppState.SetBoolValue(const Name: string; Value: Boolean);
+var
+  VariantValue: Variant;
+begin
+  VariantValue := Value;
+  SetPropValue(Self, Name, VariantValue);
+end;
+
 procedure TPppState.SetDefine(const ASymbol: string;
   const Value: TTriState);
 var
   ADefines: IJclStrMap;
   ASymbolNames: IJclStrIterator;
   Found: Boolean;
+  PI: PPropInfo;
 begin
   Found := False;
   ADefines := InternalPeekDefines;
@@ -476,10 +477,37 @@
       Break;
     end;
   end;
+  if (not Found) and (Value <> ttUnknown) then
+  begin
+    PI := GetPropInfo(Self, ASymbol);
+    if Assigned(PI) then
+    begin
+      if Value = ttDefined then
+        SetPropValue(Self, PI, True)
+      else
+        SetPropValue(Self, PI, False);
+    end;
+  end;
   if not Found then
     ADefines.Items[ASymbol] := TObject(Value);
 end;
 
+procedure TPppState.SetIntegerValue(const Name: string; Value: Integer);
+var
+  VariantValue: Variant;
+begin
+  VariantValue := Value;
+  SetPropValue(Self, Name, VariantValue);
+end;
+
+procedure TPppState.SetStringValue(const Name, Value: string);
+var
+  VariantValue: Variant;
+begin
+  VariantValue := Value;
+  SetPropValue(Self, Name, VariantValue);
+end;
+
 procedure TPppState.Undef(const ASymbol: string);
 begin
   Defines[ASymbol] := ttUndef;

Modified: trunk/jcl/experts/repository/ExceptionDialog/JclOtaExcDlgParams.pas
===================================================================
--- trunk/jcl/experts/repository/ExceptionDialog/JclOtaExcDlgParams.pas	2010-02-22 16:01:27 UTC (rev 3197)
+++ trunk/jcl/experts/repository/ExceptionDialog/JclOtaExcDlgParams.pas	2010-02-22 17:11:16 UTC (rev 3198)
@@ -84,11 +84,13 @@
     FMainThread: Boolean;
     FTraceEAbort: Boolean;
     FIgnoredExceptions: TStrings;
+    FIgnoredExceptionsIndex: Integer;
     FTraceAllExceptions: Boolean;
     function GetIgnoredExceptionsCount: Integer;
     function GetReportAllThreads: Boolean;
     function GetReportExceptionThread: Boolean;
     function GetReportMainThread: Boolean;
+    function GetIgnoredException: string;
   public
     constructor Create; reintroduce;
     destructor Destroy; override; 
@@ -129,7 +131,9 @@
     property TraceAllExceptions: Boolean read FTraceAllExceptions
       write FTraceAllExceptions;
     property TraceEAbort: Boolean read FTraceEAbort write FTraceEAbort;
+    property IgnoredException: string read GetIgnoredException;
     property IgnoredExceptions: TStrings read FIgnoredExceptions write FIgnoredExceptions;
+    property IgnoredExceptionsIndex: Integer read FIgnoredExceptionsIndex write FIgnoredExceptionsIndex;
     property IgnoredExceptionsCount: Integer read GetIgnoredExceptionsCount;
     // trace options
     property StackList: Boolean read FStackList write FStackList;
@@ -223,6 +227,11 @@
   inherited Destroy;
 end;
 
+function TJclOtaExcDlgParams.GetIgnoredException: string;
+begin
+  Result := FIgnoredExceptions.Strings[FIgnoredExceptionsIndex];
+end;
+
 function TJclOtaExcDlgParams.GetIgnoredExceptionsCount: Integer;
 begin
   Result := FIgnoredExceptions.Count;

Modified: trunk/jcl/experts/repository/ExceptionDialog/Templates/ExceptDlg.Delphi32.pas
===================================================================
--- trunk/jcl/experts/repository/ExceptionDialog/Templates/ExceptDlg.Delphi32.pas	2010-02-22 16:01:27 UTC (rev 3197)
+++ trunk/jcl/experts/repository/ExceptionDialog/Templates/ExceptDlg.Delphi32.pas	2010-02-22 17:11:16 UTC (rev 3198)
@@ -774,7 +774,7 @@
   begin
     AppEvents := TApplicationEvents.Create(nil);
     AppEvents.OnException := T%FORMNAME%.ExceptionHandler;
-(*$JPPREPEAT IgnoredExceptionsCount    AddIgnoredException({$JPPREPEATSTRVALUE IgnoredExceptions});*)
+(*$JPPLOOP IgnoredExceptionsIndex IgnoredExceptionsCount    AddIgnoredException({$JPPSTRVALUE IgnoredException});*)
 {$IFDEF TraceEAbort}    RemoveIgnoredException(EAbort);{$ENDIF}
 {$IFDEF TraceAllExceptions}    JclStackTrackingOptions := JclStackTrackingOptions + [stTraceAllExceptions];{$ENDIF}
 {$IFDEF RawData}    JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode];{$ENDIF}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3197] trunk/jcl/devtools/jpp

From: <ou...@us...> - 2010-02-22 16:01:44

Revision: 3197
          http://jcl.svn.sourceforge.net/jcl/?rev=3197&view=rev
Author:   outchy
Date:     2010-02-22 16:01:27 +0000 (Mon, 22 Feb 2010)

Log Message:
-----------
Some refactoring to extract data providers from the JPP state class.

Modified Paths:
--------------
    trunk/jcl/devtools/jpp/JppParser.pas
    trunk/jcl/devtools/jpp/JppState.pas

Modified: trunk/jcl/devtools/jpp/JppParser.pas
===================================================================
--- trunk/jcl/devtools/jpp/JppParser.pas	2010-02-22 10:08:20 UTC (rev 3196)
+++ trunk/jcl/devtools/jpp/JppParser.pas	2010-02-22 16:01:27 UTC (rev 3197)
@@ -366,7 +366,7 @@
   SavedTriState: TTriState;
 begin
   SavedTriState := FTriState;
-  FTriState := State.DefineTriState[Lexer.TokenAsString];
+  FTriState := State.Defines[Lexer.TokenAsString];
   try
     if FTriState = ttUnknown then
     begin
@@ -418,7 +418,7 @@
   case FTriState of
     ttUnknown:
       begin
-        State.DefineTriState[Lexer.TokenAsString] := ttUnknown;
+        State.Defines[Lexer.TokenAsString] := ttUnknown;
         AddResult(Lexer.RawComment);
       end;
     ttDefined: State.Define(Lexer.TokenAsString);
@@ -560,7 +560,7 @@
   case FTriState of
     ttUnknown:
       begin
-        State.DefineTriState[Lexer.TokenAsString] := ttUnknown;
+        State.Defines[Lexer.TokenAsString] := ttUnknown;
         AddResult(Lexer.RawComment);
       end;
     ttDefined: State.Undef(Lexer.TokenAsString);
@@ -625,7 +625,7 @@
   Name: string;
 begin
   Name := Lexer.TokenAsString;
-  AddResult(State.GetStrValue(Name));
+  AddResult(State.StringValues[Name]);
   NextToken;
 end;
 
@@ -634,7 +634,7 @@
   Name: string;
 begin
   Name := Lexer.TokenAsString;
-  AddResult(IntToStr(State.GetIntValue(Name)));
+  AddResult(IntToStr(State.IntegerValues[Name]));
   NextToken;
 end;
 
@@ -643,7 +643,7 @@
   Name: string;
 begin
   Name := Lexer.TokenAsString;
-  AddResult(BoolToStr(State.GetBoolValue(Name), True));
+  AddResult(BoolToStr(State.BoolValues[Name], True));
   NextToken;
 end;
 
@@ -668,7 +668,7 @@
     if RepeatText[I] = ')' then
       Dec(I);
     RepeatText := Copy(RepeatText, J, I - J);
-    FRepeatIndex := State.GetIntValue(CountName);
+    FRepeatIndex := State.IntegerValues[CountName];
     while FRepeatIndex > 0 do
     begin
       Dec(FRepeatIndex);
@@ -688,7 +688,7 @@
   if FRepeatIndex > -1 then
   begin
     Name := Lexer.TokenAsString;
-    AddResult(State.GetStringsValue(Name).Strings[FRepeatIndex]);
+    AddResult(State.StringsValues[Name].Strings[FRepeatIndex]);
     NextToken;
   end
   else

Modified: trunk/jcl/devtools/jpp/JppState.pas
===================================================================
--- trunk/jcl/devtools/jpp/JppState.pas	2010-02-22 10:08:20 UTC (rev 3196)
+++ trunk/jcl/devtools/jpp/JppState.pas	2010-02-22 16:01:27 UTC (rev 3197)
@@ -63,7 +63,23 @@
 
   TTriState = (ttUnknown, ttUndef, ttDefined);
 
-  TPppState = class(TPersistent)
+  TPppProvider = class(TPersistent)
+  protected
+    function GetBoolValue(const Name: string): Boolean; virtual; abstract;
+    function GetStringValue(const Name: string): string; virtual; abstract;
+    function GetIntegerValue(const Name: string): Integer; virtual; abstract;
+    function GetStringsValue(const Name: string): TStrings; virtual; abstract;
+    function GetDefine(const ASymbol: string): TTriState; virtual; abstract;
+    procedure SetDefine(const ASymbol: string; const Value: TTriState); virtual; abstract;
+  public
+    property Defines[const ASymbol: string]: TTriState read GetDefine write SetDefine;
+    property BoolValues[const Name: string]: Boolean read GetBoolValue;
+    property StringValues[const Name: string]: string read GetStringValue;
+    property IntegerValues[const Name: string]: Integer read GetIntegerValue;
+    property StringsValues[const Name: string]: TStrings read GetStringsValue;
+  end;
+
+  TPppState = class(TPppProvider)
   private
     FStateStack: IJclStack;
     FOptions: TPppOptions;
@@ -77,8 +93,12 @@
     function GetOptions: TPppOptions;
     procedure SetOptions(AOptions: TPppOptions);
 
-    function GetDefineTriState(const ASymbol: string): TTriState;
-    procedure SetDefineTriState(const ASymbol: string; const Value: TTriState);
+    function GetDefine(const ASymbol: string): TTriState; override;
+    procedure SetDefine(const ASymbol: string; const Value: TTriState); override;
+    function GetBoolValue(const Name: string): Boolean; override;
+    function GetStringValue(const Name: string): string; override;
+    function GetIntegerValue(const Name: string): Integer; override;
+    function GetStringsValue(const Name: string): TStrings; override;
   public
     constructor Create;
     destructor Destroy; override;
@@ -89,12 +109,6 @@
     procedure PushState;
     procedure PopState;
 
-    function IsDefined(const ASymbol: string): Boolean;
-    function GetBoolValue(const Name: string): Boolean;
-    function GetStrValue(const Name: string): string;
-    function GetIntValue(const Name: string): Integer;
-    function GetStringsValue(const Name: string): TStrings;
-
     procedure Define(const ASymbol: string);
     procedure Undef(const ASymbol: string);
 
@@ -110,7 +124,6 @@
     procedure UndefMacro(const AName: string; const ParamNames: TDynStringArray);
 
     property Options: TPppOptions read GetOptions write SetOptions;
-    property DefineTriState[const ASymbol: string]: TTriState read GetDefineTriState write SetDefineTriState;
   end;
 
 {$IFDEF UNITVERSIONING}
@@ -231,7 +244,7 @@
 
 procedure TPppState.Define(const ASymbol: string);
 begin
-  SetDefineTriState(ASymbol, ttDefined);
+  Defines[ASymbol] := ttDefined;
 end;
 
 procedure TPppState.DefineMacro(const AName: string;
@@ -295,7 +308,7 @@
   Result := Boolean(VariantValue);
 end;
 
-function TPppState.GetIntValue(const Name: string): Integer;
+function TPppState.GetIntegerValue(const Name: string): Integer;
 var
   VariantValue: Variant;
 begin
@@ -314,7 +327,7 @@
     Result := nil;
 end;
 
-function TPppState.GetStrValue(const Name: string): string;
+function TPppState.GetStringValue(const Name: string): string;
 var
   VariantValue: Variant;
 begin
@@ -327,7 +340,7 @@
   Result := FOptions;
 end;
 
-function TPppState.GetDefineTriState(const ASymbol: string): TTriState;
+function TPppState.GetDefine(const ASymbol: string): TTriState;
 var
   ADefines: IJclStrMap;
   ASymbolNames: IJclStrIterator;
@@ -400,11 +413,6 @@
   FStateStack.Push(AStateItem);
 end;
 
-function TPppState.IsDefined(const ASymbol: string): Boolean;
-begin
-  Result := DefineTriState[ASymbol] = ttDefined;
-end;
-
 function TPppState.IsFileExcluded(const AName: string): Boolean;
 var
   AExcludedFiles: IJclStrList;
@@ -449,7 +457,7 @@
   FOptions := AOptions;
 end;
 
-procedure TPppState.SetDefineTriState(const ASymbol: string;
+procedure TPppState.SetDefine(const ASymbol: string;
   const Value: TTriState);
 var
   ADefines: IJclStrMap;
@@ -474,7 +482,7 @@
 
 procedure TPppState.Undef(const ASymbol: string);
 begin
-  SetDefineTriState(ASymbol, ttUndef);
+  Defines[ASymbol] := ttUndef;
 end;
 
 procedure TPppState.UndefMacro(const AName: string; const ParamNames: TDynStringArray);


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3196] trunk/jcl/source

From: <ou...@us...> - 2010-02-22 10:08:40

Revision: 3196
          http://jcl.svn.sourceforge.net/jcl/?rev=3196&view=rev
Author:   outchy
Date:     2010-02-22 10:08:20 +0000 (Mon, 22 Feb 2010)

Log Message:
-----------
Mantis 5175: $weakpackageunit and unitversioning info are not compatible.

Modified Paths:
--------------
    trunk/jcl/source/common/pcre.pas
    trunk/jcl/source/windows/MSHelpServices_TLB.pas
    trunk/jcl/source/windows/MSTask.pas
    trunk/jcl/source/windows/mscoree_TLB.pas
    trunk/jcl/source/windows/mscorlib_TLB.pas

Modified: trunk/jcl/source/common/pcre.pas
===================================================================
--- trunk/jcl/source/common/pcre.pas	2010-02-21 11:36:35 UTC (rev 3195)
+++ trunk/jcl/source/common/pcre.pas	2010-02-22 10:08:20 UTC (rev 3196)
@@ -54,7 +54,13 @@
 *       Perl-Compatible Regular Expressions      *
 *************************************************)
 
-{$WEAKPACKAGEUNIT ON}
+{$IFDEF SUPPORTS_WEAKPACKAGEUNIT}
+  {$IFDEF UNITVERSIONING}
+    {$WEAKPACKAGEUNIT OFF}
+  {$ELSE ~UNITVERSIONING}
+    {$WEAKPACKAGEUNIT ON}
+  {$ENDIF ~UNITVERSIONING}
+{$ENDIF SUPPORTS_WEAKPACKAGEUNIT}
 
 // (p3) this is the switch to change between static and dynamic linking.
 // It is set to dynamic by default. To disable simply insert a '.' before the '$'

Modified: trunk/jcl/source/windows/MSHelpServices_TLB.pas
===================================================================
--- trunk/jcl/source/windows/MSHelpServices_TLB.pas	2010-02-21 11:36:35 UTC (rev 3195)
+++ trunk/jcl/source/windows/MSHelpServices_TLB.pas	2010-02-22 10:08:20 UTC (rev 3196)
@@ -58,7 +58,11 @@
 {$I jcl.inc}
 
 {$IFDEF SUPPORTS_WEAKPACKAGEUNIT}
-{$WEAKPACKAGEUNIT ON}
+  {$IFDEF UNITVERSIONING}
+    {$WEAKPACKAGEUNIT OFF}
+  {$ELSE ~UNITVERSIONING}
+    {$WEAKPACKAGEUNIT ON}
+  {$ENDIF ~UNITVERSIONING} 
 {$ENDIF SUPPORTS_WEAKPACKAGEUNIT}
 
 interface

Modified: trunk/jcl/source/windows/MSTask.pas
===================================================================
--- trunk/jcl/source/windows/MSTask.pas	2010-02-21 11:36:35 UTC (rev 3195)
+++ trunk/jcl/source/windows/MSTask.pas	2010-02-22 10:08:20 UTC (rev 3196)
@@ -35,11 +35,19 @@
 
 {$ALIGN ON}
 {$MINENUMSIZE 4}
-{$WEAKPACKAGEUNIT}
+
 interface
 
 {$I jcl.inc}
 
+{$IFDEF SUPPORTS_WEAKPACKAGEUNIT}
+  {$IFDEF UNITVERSIONING}
+    {$WEAKPACKAGEUNIT OFF}
+  {$ELSE ~UNITVERSIONING}
+    {$WEAKPACKAGEUNIT ON}
+  {$ENDIF ~UNITVERSIONING}
+{$ENDIF SUPPORTS_WEAKPACKAGEUNIT}
+
 uses
   {$IFDEF UNITVERSIONING}
   JclUnitVersioning,

Modified: trunk/jcl/source/windows/mscoree_TLB.pas
===================================================================
--- trunk/jcl/source/windows/mscoree_TLB.pas	2010-02-21 11:36:35 UTC (rev 3195)
+++ trunk/jcl/source/windows/mscoree_TLB.pas	2010-02-22 10:08:20 UTC (rev 3196)
@@ -41,7 +41,11 @@
 {$I jcl.inc}
 
 {$IFDEF SUPPORTS_WEAKPACKAGEUNIT}
-{$WEAKPACKAGEUNIT ON}
+  {$IFDEF UNITVERSIONING}
+    {$WEAKPACKAGEUNIT OFF}
+  {$ELSE ~UNITVERSIONING}
+    {$WEAKPACKAGEUNIT ON}
+  {$ENDIF ~UNITVERSIONING}
 {$ENDIF SUPPORTS_WEAKPACKAGEUNIT}
 
 interface

Modified: trunk/jcl/source/windows/mscorlib_TLB.pas
===================================================================
--- trunk/jcl/source/windows/mscorlib_TLB.pas	2010-02-21 11:36:35 UTC (rev 3195)
+++ trunk/jcl/source/windows/mscorlib_TLB.pas	2010-02-22 10:08:20 UTC (rev 3196)
@@ -59,7 +59,11 @@
 {$I jcl.inc}
 
 {$IFDEF SUPPORTS_WEAKPACKAGEUNIT}
-{$WEAKPACKAGEUNIT ON}
+  {$IFDEF UNITVERSIONING}
+    {$WEAKPACKAGEUNIT OFF}
+  {$ELSE ~UNITVERSIONING}
+    {$WEAKPACKAGEUNIT ON}
+  {$ENDIF ~UNITVERSIONING} 
 {$ENDIF SUPPORTS_WEAKPACKAGEUNIT}
 
 interface


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3195] trunk/jcl

From: <ou...@us...> - 2010-02-21 11:36:43

Revision: 3195
          http://jcl.svn.sourceforge.net/jcl/?rev=3195&view=rev
Author:   outchy
Date:     2010-02-21 11:36:35 +0000 (Sun, 21 Feb 2010)

Log Message:
-----------
Added support for association by name to the JPP expand macro directive.

Modified Paths:
--------------
    trunk/jcl/devtools/jpp/JppState.pas
    trunk/jcl/source/prototypes/JclContainerIntf.pas

Modified: trunk/jcl/devtools/jpp/JppState.pas
===================================================================
--- trunk/jcl/devtools/jpp/JppState.pas	2010-02-19 21:09:29 UTC (rev 3194)
+++ trunk/jcl/devtools/jpp/JppState.pas	2010-02-21 11:36:35 UTC (rev 3195)
@@ -171,9 +171,11 @@
   AMacros: IJclStrIntfMap;
   AMacro: IJclStrList;
   AMacroNames: IJclStrIterator;
-  AMacroName, AMacroText: string;
-  Index: Integer;
+  AMacroName, AMacroText, AParamName, AParamText: string;
+  Index, ParamIndex: Integer;
   Params: array of TVarRec;
+  StrParams: TStrings;
+  AssociationByName: Boolean;
 begin
   AMacros := InternalPeekMacros;
   AMacroName := Format('%s`%d', [AName, Length(ParamValues)]);
@@ -182,20 +184,45 @@
   begin
     if JclStrings.StrSame(AMacroNames.Next, AMacroName) then
     begin
-      SetLength(Params, Length(ParamValues));
-      for Index := Low(ParamValues) to High(ParamValues) do
-      begin
-        {$IFDEF SUPPORTS_UNICODE}
-        Params[Index].VType := vtPWideChar;
-        Params[Index].VPWideChar := PWideChar(ParamValues[Index]);
-        {$ELSE ~SUPPORTS_UNICODE}
-        Params[Index].VType := vtPChar;
-        Params[Index].VPChar := PAnsiChar(ParamValues[Index]);
-        {$ENDIF ~SUPPORTS_UNICODE}
-      end;
       AMacro := AMacros.Items[AMacroNames.GetString] as IJclStrList;
+      // the macro text is the last item, previous items are the macro parameter names
       AMacroText := AMacro.Strings[AMacro.Size - 1];
-      Result := Format(AMacroText, Params);
+      AssociationByName := True;
+      StrParams := TStringList.Create;
+      try
+        for Index := Low(ParamValues) to High(ParamValues) do
+        begin
+          StrParams.Add(ParamValues[Index]);
+          AParamName := StrParams.Names[Index];
+          if AParamName <> '' then
+          begin
+            // verify parameter names
+            ParamIndex := AMacro.IndexOf(AParamName);
+            if (ParamIndex < 0) or (ParamIndex > (AMacro.Size - 1)) then
+              AssociationByName := False;
+          end
+          else
+            AssociationByName := False;
+        end;
+        SetLength(Params, Length(ParamValues));
+        for Index := Low(ParamValues) to High(ParamValues) do
+        begin
+          if AssociationByName then
+            AParamText := StrParams.Values[AMacro.Strings[Index]]
+          else
+            AParamText := StrParams.Strings[Index];
+          {$IFDEF SUPPORTS_UNICODE}
+          Params[Index].VType := vtPWideChar;
+          Params[Index].VPWideChar := PWideChar(AParamText);
+          {$ELSE ~SUPPORTS_UNICODE}
+          Params[Index].VType := vtPChar;
+          Params[Index].VPChar := PAnsiChar(AParamText);
+          {$ENDIF ~SUPPORTS_UNICODE}
+        end;
+        Result := Format(AMacroText, Params);
+      finally
+        StrParams.Free;
+      end;
       Exit;
     end;
   end;

Modified: trunk/jcl/source/prototypes/JclContainerIntf.pas
===================================================================
--- trunk/jcl/source/prototypes/JclContainerIntf.pas	2010-02-19 21:09:29 UTC (rev 3194)
+++ trunk/jcl/source/prototypes/JclContainerIntf.pas	2010-02-21 11:36:35 UTC (rev 3195)
@@ -65,7 +65,7 @@
   // function pointer types
 
   // apply functions Type -> Type
-  {$JPPEXPANDMACRO APPLYFUNCTION(TIntfApplyFunction,const ,AInterface,IInterface)}
+  {$JPPEXPANDMACRO APPLYFUNCTION(TYPENAME=IInterface,FUNCNAME=TIntfApplyFunction,CONSTKEYWORD=const ,PARAMETERNAME=AInterface)}
   {$JPPEXPANDMACRO APPLYFUNCTION(TAnsiStrApplyFunction,const ,AString,AnsiString)}
   {$JPPEXPANDMACRO APPLYFUNCTION(TWideStrApplyFunction,const ,AString,WideString)}
   {$IFDEF SUPPORTS_UNICODE_STRING}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3194] trunk/jcl/devtools/jpp/JppState.pas

From: <ou...@us...> - 2010-02-19 21:09:36

Revision: 3194
          http://jcl.svn.sourceforge.net/jcl/?rev=3194&view=rev
Author:   outchy
Date:     2010-02-19 21:09:29 +0000 (Fri, 19 Feb 2010)

Log Message:
-----------
Store the macro parameter names in JPP internal state.

Modified Paths:
--------------
    trunk/jcl/devtools/jpp/JppState.pas

Modified: trunk/jcl/devtools/jpp/JppState.pas
===================================================================
--- trunk/jcl/devtools/jpp/JppState.pas	2010-02-18 21:40:40 UTC (rev 3193)
+++ trunk/jcl/devtools/jpp/JppState.pas	2010-02-19 21:09:29 UTC (rev 3194)
@@ -68,10 +68,10 @@
     FStateStack: IJclStack;
     FOptions: TPppOptions;
     procedure InternalPushState(const ExcludedFiles, SearchPath: IJclStrList;
-      const Macros: IJclStrStrMap; const Defines: IJclStrMap);
+      const Macros: IJclStrIntfMap; const Defines: IJclStrMap);
     function InternalPeekDefines: IJclStrMap;
     function InternalPeekExcludedFiles: IJclStrList;
-    function InternalPeekMacros: IJclStrStrMap;
+    function InternalPeekMacros: IJclStrIntfMap;
     function InternalPeekSearchPath: IJclStrList;
   protected
     function GetOptions: TPppOptions;
@@ -136,7 +136,7 @@
   public
     DefinedKeywords: IJclStrMap;
     ExcludedFiles: IJclStrList;
-    Macros: IJclStrStrMap;
+    Macros: IJclStrIntfMap;
     SearchPath: IJclStrList;
   end;
 
@@ -146,7 +146,7 @@
 begin
   FStateStack := TJclStack.Create(16, True);
   InternalPushState(TJclStrArrayList.Create(16), TJclStrArrayList.Create(16),
-    TJclStrStrHashMap.Create(16), TJclStrHashMap.Create(16, False));
+    TJclStrIntfHashMap.Create(16), TJclStrHashMap.Create(16, False));
 end;
 
 destructor TPppState.Destroy;
@@ -168,9 +168,10 @@
 function TPppState.ExpandMacro(const AName: string;
   const ParamValues: TDynStringArray): string;
 var
-  AMacros: IJclStrStrMap;
+  AMacros: IJclStrIntfMap;
+  AMacro: IJclStrList;
   AMacroNames: IJclStrIterator;
-  AMacroName: string;
+  AMacroName, AMacroText: string;
   Index: Integer;
   Params: array of TVarRec;
 begin
@@ -192,7 +193,9 @@
         Params[Index].VPChar := PAnsiChar(ParamValues[Index]);
         {$ENDIF ~SUPPORTS_UNICODE}
       end;
-      Result := Format(AMacros.Items[AMacroNames.GetString], Params);
+      AMacro := AMacros.Items[AMacroNames.GetString] as IJclStrList;
+      AMacroText := AMacro.Strings[AMacro.Size - 1];
+      Result := Format(AMacroText, Params);
       Exit;
     end;
   end;
@@ -207,7 +210,8 @@
 procedure TPppState.DefineMacro(const AName: string;
   const ParamNames: TDynStringArray; const Value: string);
 var
-  AMacros: IJclStrStrMap;
+  AMacro: IJclStrList;
+  AMacros: IJclStrIntfMap;
   AMacroNames: IJclStrIterator;
   AMacroName, AMacroFormat: string;
   Index: Integer;
@@ -219,9 +223,16 @@
     if JclStrings.StrSame(AMacroNames.Next, AMacroName) then
       raise EPppState.CreateFmt('macro "%s" is already defined', [AName]);
   AMacroFormat := Value;
+  AMacro := TJclStrArrayList.Create(16);
   for Index := Low(ParamNames) to High(ParamNames) do
+  begin
     StrReplace(AMacroFormat, ParamNames[Index], '%' + IntToStr(Index) + ':s', [rfReplaceAll, rfIgnoreCase]);
-  AMacros.Items[AMacroName] := AMacroFormat;
+    // the first elements in the list are the macro parameter names
+    AMacro.Add(ParamNames[Index]);
+  end;
+  // the macro text is the last element in the list
+  AMacro.Add(AMacroFormat);
+  AMacros.Items[AMacroName] := AMacro;
 end;
 
 function TPppState.FindFile(const AName: string): TStream;
@@ -335,7 +346,7 @@
   Result := (FStateStack.Peek as TSimplePppStateItem).ExcludedFiles;
 end;
 
-function TPppState.InternalPeekMacros: IJclStrStrMap;
+function TPppState.InternalPeekMacros: IJclStrIntfMap;
 begin
   if FStateStack.Empty then
     raise EPppState.Create('Internal error: PPP State stack is empty');
@@ -350,7 +361,7 @@
 end;
 
 procedure TPppState.InternalPushState(const ExcludedFiles,
-  SearchPath: IJclStrList; const Macros: IJclStrStrMap; const Defines: IJclStrMap);
+  SearchPath: IJclStrList; const Macros: IJclStrIntfMap; const Defines: IJclStrMap);
 var
   AStateItem: TSimplePppStateItem;
 begin
@@ -396,12 +407,12 @@
 var
   AExcludedFiles, ASearchPath: IJclStrList;
   ADefines: IJclStrMap;
-  AMacros: IJclStrStrMap;
+  AMacros: IJclStrIntfMap;
 begin
   ADefines := (InternalPeekDefines as IJclIntfCloneable).IntfClone as IJclStrMap;
   AExcludedFiles := (InternalPeekExcludedFiles as IJclIntfCloneable).IntfClone as IJclStrList;
   ASearchPath := (InternalPeekSearchPath as IJclIntfCloneable).IntfClone as IJclStrList;
-  AMacros := (InternalPeekMacros as IJclIntfCloneable).IntfClone as IJclStrStrMap;
+  AMacros := (InternalPeekMacros as IJclIntfCloneable).IntfClone as IJclStrIntfMap;
 
   InternalPushState(AExcludedFiles, ASearchPath, AMacros, ADefines);
 end;
@@ -441,7 +452,7 @@
 
 procedure TPppState.UndefMacro(const AName: string; const ParamNames: TDynStringArray);
 var
-  AMacros: IJclStrStrMap;
+  AMacros: IJclStrIntfMap;
   AMacroNames: IJclStrIterator;
   AMacroName: string;
 begin


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3193] trunk/jcl/source/common/JclRTTI.pas

From: <ou...@us...> - 2010-02-18 21:40:46

Revision: 3193
          http://jcl.svn.sourceforge.net/jcl/?rev=3193&view=rev
Author:   outchy
Date:     2010-02-18 21:40:40 +0000 (Thu, 18 Feb 2010)

Log Message:
-----------
New function "GetStringPropList" to return the list of properties whose type is "string". On Unicode-enabled versions of Delphi, their PropKind is tkUString, otherwise it is tkString.

Modified Paths:
--------------
    trunk/jcl/source/common/JclRTTI.pas

Modified: trunk/jcl/source/common/JclRTTI.pas
===================================================================
--- trunk/jcl/source/common/JclRTTI.pas	2010-02-18 21:16:35 UTC (rev 3192)
+++ trunk/jcl/source/common/JclRTTI.pas	2010-02-18 21:40:40 UTC (rev 3193)
@@ -590,6 +590,9 @@
 function JclIsClass(const AnObj: TObject; const AClass: TClass): Boolean;
 function JclIsClassByName(const AnObj: TObject; const AClass: TClass): Boolean;
 
+// returns all properties of type string (kind = tkString or kind = tkUString when Unicode is enabled)
+function GetStringPropList(TypeInfo: PTypeInfo; out PropList: PPropList): Integer;
+
 {$IFDEF UNITVERSIONING}
 const
   UnitVersioning: TUnitVersionInfo = (
@@ -2480,6 +2483,26 @@
     raise EInvalidCast.CreateRes(@SInvalidCast);
 end;
 
+function GetStringPropList(TypeInfo: PTypeInfo; out PropList: PPropList): Integer;
+begin
+  PropList := nil;
+  {$IFDEF SUPPORTS_UNICODE_STRING}
+  Result := GetPropList(TypeInfo, [tkUString], PropList);
+  if Result > 0 then
+  begin
+    GetMem(PropList, Result * SizeOf(PropList[0]));
+    Result := GetPropList(TypeInfo, [tkUString], PropList);
+  end;
+  {$ELSE ~SUPPORTS_UNICODE_STRING}
+  Result := GetPropList(TypeInfo, [tkString], PropList);
+  if Result > 0 then
+  begin
+    GetMem(PropList, Result * SizeOf(PropList[0]));
+    Result := GetPropList(TypeInfo, [tkString], PropList);
+  end;
+  {$ENDIF ~SUPPORTS_UNICODE_STRING}
+end;
+
 initialization
   TypeList := TThreadList.Create;
   {$IFDEF UNITVERSIONING}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

49 messages has been excluded from this view by a project administrator.

Flat | Threaded

<< < 1 .. 26 27 28 29 30 .. 92 > >> (Page 28 of 92)