--- Merging r17697 into '.':

U    utils/instantfpc/instantfptools.pas
--- Merging r17716 into '.':
U    packages/fcl-image/src/fpwritepng.pp
--- Merging r17717 into '.':
U    rtl/objpas/sysutils/filutilh.inc
U    rtl/objpas/sysutils/sysutils.inc
--- Merging r17945 into '.':
U    utils/instantfpc/instantfpc.pas
--- Merging r17946 into '.':
G    utils/instantfpc/instantfptools.pas
--- Merging r17947 into '.':
G    utils/instantfpc/instantfpc.pas
--- Merging r17951 into '.':
G    utils/instantfpc/instantfptools.pas
G    utils/instantfpc/instantfpc.pas
--- Merging r17964 into '.':
U    utils/instantfpc/examples/writeparameters.pas
U    utils/instantfpc/examples/helloworld.pas
--- Merging r17966 into '.':
U    packages/gdbm/src/gdbm.pp

# revisions: 17697,17716,17717,17945,17946,17947,17951,17964,17966
------------------------------------------------------------------------
r17697 | florian | 2011-06-08 19:43:28 +0200 (Wed, 08 Jun 2011) | 1 line
Changed paths:
   M /trunk/utils/instantfpc/instantfptools.pas

* fix buildin on wince, resolves #19525
------------------------------------------------------------------------
------------------------------------------------------------------------
r17716 | marco | 2011-06-11 10:46:35 +0200 (Sat, 11 Jun 2011) | 2 lines
Changed paths:
   M /trunk/packages/fcl-image/src/fpwritepng.pp

 * ability to set png writer's zlib Compressionlevel, fixes Mantis #19224

------------------------------------------------------------------------
------------------------------------------------------------------------
r17717 | michael | 2011-06-11 13:36:51 +0200 (Sat, 11 Jun 2011) | 6 lines
Changed paths:
   M /trunk/rtl/objpas/sysutils/filutilh.inc
   M /trunk/rtl/objpas/sysutils/sysutils.inc

* Changed FileSearch to handle a set of options instead of boolean.
  Options now include stripquotes
* Changed ExeSearch so dirlist is optional and PATH is used if omitted. 
  It uses stripQuotes on windows. (bug 19282)


------------------------------------------------------------------------
------------------------------------------------------------------------
r17945 | michael | 2011-07-06 21:47:47 +0200 (Wed, 06 Jul 2011) | 1 line
Changed paths:
   M /trunk/utils/instantfpc/instantfpc.pas

* Force an extension on cache filename, so extension can be skipped in script name.
------------------------------------------------------------------------
------------------------------------------------------------------------
r17946 | michael | 2011-07-06 22:14:30 +0200 (Wed, 06 Jul 2011) | 1 line
Changed paths:
   M /trunk/utils/instantfpc/instantfptools.pas

* Allow .cgi as extension
------------------------------------------------------------------------
------------------------------------------------------------------------
r17947 | michael | 2011-07-06 22:16:45 +0200 (Wed, 06 Jul 2011) | 1 line
Changed paths:
   M /trunk/utils/instantfpc/instantfpc.pas

* Force .pas extension if extension not in .pas .pp .lpr
------------------------------------------------------------------------
------------------------------------------------------------------------
r17951 | michael | 2011-07-07 21:03:08 +0200 (Thu, 07 Jul 2011) | 1 line
Changed paths:
   M /trunk/utils/instantfpc/instantfpc.pas
   M /trunk/utils/instantfpc/instantfptools.pas

* Improved interpretation of shebang line under linux. Added --set-cache argument
------------------------------------------------------------------------
------------------------------------------------------------------------
r17964 | mattias | 2011-07-09 10:40:27 +0200 (Sat, 09 Jul 2011) | 1 line
Changed paths:
   M /trunk/utils/instantfpc/examples/helloworld.pas
   M /trunk/utils/instantfpc/examples/writeparameters.pas

instantfpc: example for mode directive
------------------------------------------------------------------------
------------------------------------------------------------------------
r17966 | marco | 2011-07-09 23:34:32 +0200 (Sat, 09 Jul 2011) | 2 lines
Changed paths:
   M /trunk/packages/gdbm/src/gdbm.pp

 * assume callback is cdecl

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@17973 -

packages/fcl-image/src/fpwritepng.pp

@@ -41,6 +41,7 @@ type
       FDatalineLength : longword;
       ZData : TMemoryStream;  // holds uncompressed data until all blocks are written
       Compressor : TCompressionStream; // compresses the data
+      FCompressionLevel : TCompressionLevel;
       procedure WriteChunk;
       function GetColorPixel (x,y:longword) : TColorData;
       function GetPalettePixel (x,y:longword) : TColorData;
@@ -94,6 +95,7 @@ type
       property CompressedText : boolean read FCompressedText write FCompressedText;
       property WordSized : boolean read FWordSized write FWordSized;
       property UseAlpha : boolean read FUseAlpha write FUseAlpha;
+      property CompressionLevel : TCompressionLevel read FCompressionLevel write FCompressionLevel;
   end;
 
 implementation
@@ -108,6 +110,7 @@ begin
   FCompressedText := True;
   FWordSized := True;
   FUseAlpha := False;
+  FCompressionLevel:=clDefault;
 end;
 
 destructor TFPWriterPNG.destroy;
@@ -565,7 +568,7 @@ begin
   GetMem (FCurrentLine, FDatalineLength);
   fillchar (FCurrentLine^,FDatalineLength,0);
   ZData := TMemoryStream.Create;
-  Compressor := TCompressionStream.Create (clMax,ZData);
+  Compressor := TCompressionStream.Create (FCompressionLevel,ZData);
   FGetPixel := DecideGetPixel;
 end;
 

packages/gdbm/src/gdbm.pp

@@ -89,8 +89,7 @@ type
   end;
   PGDBM_FILE = ^TGDBM_FILE;
 
-  TGDBMErrorCallBack = Procedure;
-
+  TGDBMErrorCallBack = Procedure; cdecl;
 
 
 var

rtl/objpas/sysutils/filutilh.inc

@@ -71,6 +71,10 @@ Const
   { File errors }
   feInvalidHandle : THandle = THandle(-1);  //return value on FileOpen error
 
+Type
+  TFileSearchOption = (sfoImplicitCurrentDir,sfoStripQuotes);
+  TFileSearchOptions = set of TFileSearchOption;
+
 Function FileOpen (Const FileName : string; Mode : Integer) : THandle;
 Function FileCreate (Const FileName : String) : THandle;
 Function FileCreate (Const FileName : String; Mode : Integer) : THandle;
@@ -95,8 +99,10 @@ Function FileGetAttr (Const FileName : String) : Longint;
 Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
 Function DeleteFile (Const FileName : String) : Boolean;
 Function RenameFile (Const OldName, NewName : String) : Boolean;
-Function FileSearch (Const Name, DirList : String; ImplicitCurrentDir : Boolean = True) : String;
-Function ExeSearch  (Const Name, DirList : String) : String;
+
+Function FileSearch (Const Name, DirList : String; Options : TFileSearchoptions = []) : String;
+Function FileSearch (Const Name, DirList : String; ImplicitCurrentDir : Boolean) : String;
+Function ExeSearch  (Const Name : String; Const DirList : String = '') : String;
 Function FileIsReadOnly(const FileName: String): Boolean;
 
 Function GetFileHandle(var f : File):Longint;

rtl/objpas/sysutils/sysutils.inc

@@ -18,7 +18,7 @@
   { variant error codes }
   {$i varerror.inc}
 
-    Function FileSearch (Const Name, DirList : String; ImplicitCurrentDir : Boolean = True) : String;
+    Function FileSearch (Const Name, DirList : String; Options : TFileSearchoptions = []) : String;
     Var
       I : longint;
       Temp : String;
@@ -27,7 +27,7 @@
       Result:=Name;
       temp:=SetDirSeparators(DirList);
       // Start with checking the file in the current directory
-      If ImplicitCurrentDir and (Result <> '') and FileExists(Result) Then
+      If (sfoImplicitCurrentDir in Options) and (Result <> '') and FileExists(Result) Then
         exit;
       while True do begin
         If Temp = '' then
@@ -44,21 +44,42 @@
             Temp:='';
           end;
         If Result<>'' then
-          Result:=IncludeTrailingPathDelimiter(Result)+name;
+          begin
+          If (sfoStripQuotes in Options) and (Result[1]='"') and (Result[Length(Result)]='"') then
+            Result:=Copy(Result,2,Length(Result)-2);
+          if (Result<>'') then
+            Result:=IncludeTrailingPathDelimiter(Result)+name;
+          end;
         If (Result <> '') and FileExists(Result) Then
           exit;
       end;
       result:='';
     end;
 
-    Function ExeSearch (Const Name, DirList : String) : String;
+    Function FileSearch (Const Name, DirList : String; ImplicitCurrentDir : Boolean) : String;
 
     begin
+      if ImplicitCurrentDir then
+        Result:=FileSearch(Name,DirList,[sfoImplicitCurrentDir])
+      else  
+        Result:=FileSearch(Name,DirList,[]);
+    end;
+    
+    Function ExeSearch (Const Name : String; Const DirList : String ='' ) : String;
+    
+    Var
+      D : String;
+      O : TFileSearchOptions;
+    begin
+      D:=DirList;
+      if (D='') then
+        D:=GetEnvironmentVariable('PATH');
     {$ifdef unix}
-      Result := FileSearch(Name, DirList, False);
+      O:=[];
     {$else unix}
-      Result := FileSearch(Name, DirList, True);
+      O:=(sfoImplicitCurrentDir,sfoStripQuotes);
     {$endif unix}
+      Result := FileSearch(Name, D, False);
     end;
 
   {$ifndef OS_FILEISREADONLY}

utils/instantfpc/examples/helloworld.pas

@@ -1,4 +1,4 @@
 #!/usr/bin/env instantfpc
 begin
-  writeln('Hello world 2');
+  writeln('Hello world!');
 end.

utils/instantfpc/examples/writeparameters.pas

@@ -1,4 +1,5 @@
 #!/usr/bin/env instantfpc
+{$mode objfpc}{$H+}
 var
   i: Integer;
 begin

utils/instantfpc/instantfpc.pas

@@ -27,8 +27,52 @@ uses
 const
   Version = '1.0';
 
+
+Procedure Usage;
+
+begin
+  writeln('instantfpc '+Version);
+  writeln;
+  writeln('instantfpc -h');
+  writeln('      This help message.');
+  writeln;
+  writeln('instantfpc -v');
+  writeln('      Print version and exit.');
+  writeln;
+  writeln('instantfpc [compiler options] <source file> [program parameters]');
+  writeln('      Compiles source and runs program.');
+  writeln('      Source is compared with the cache. If cache is not valid then');
+  writeln('      source is copied to cache with the shebang line commented and');
+  writeln('      cached source is compiled.');
+  writeln('      If compilation fails the fpc output is written to stdout and');
+  writeln('      instantfpc exits with error code 1.');
+  writeln('      If compilation was successful the program is executed.');
+  writeln('      If the compiler options contains -B the program is always');
+  writeln('      compiled.');
+  writeln;
+  writeln('instantfpc --get-cache');
+  writeln('      Prints cache directory to stdout.');
+  writeln;
+  writeln('instantfpc --set-cache=<path to cache>');
+  writeln('      Set the cache to be used.');
+  writeln;
+  writeln('instantfpc --compiler=<path to compiler>');
+  writeln('      Normally fpc is searched in PATH and used as compiler.');
+  writeln;
+  writeln('Normal usage is to add as first line ("shebang") "#!/usr/bin/instantfpc"');
+  writeln('to a program source file. Then you can execute the source like a script.');
+  Halt(0);
+end;
+
+Procedure DisplayCache;
+
+begin
+  write(GetCacheDir);
+  Halt(0);
+end ;
+
 var
-  i: Integer;
+  i,j: Integer;
   p: String;
   Filename: String;
   Src: TStringList;
@@ -36,65 +80,80 @@ var
   CacheFilename: String;
   OutputFilename: String;
   ExeExt: String;
+  E : String;
+  
+// Return true if filename found.
+  
+Function InterpretParam(p : String) : boolean;
+  
+begin
+  Result:=False;
+  if (P='') then exit;
+  if p='-v' then 
+    begin
+    writeln('instantfpc '+Version);
+    Halt(1);
+    end
+  else if p='-h' then 
+    usage
+  else if p='--get-cache' then 
+    DisplayCache
+  else if copy(p,1,11)='--compiler=' then 
+    begin
+    delete(P,1,11);
+    SetCompiler(p);
+    end 
+  else if copy(p,1,12)='--set-cache=' then 
+    begin
+    delete(P,1,12);
+    SetCacheDir(p);
+    end 
+  else if (P<>'') and (p[1]<>'-') then 
+    begin
+    Filename:=p;
+    Result:=True;
+    end;
+end;
+  
 begin
   Filename:='';
   { For example:
       /usr/bin/instantfpc -MObjFpc -Sh ./envvars.pas param1
   }
-  for i:=1 to Paramcount do begin
+  for i:=1 to Paramcount do 
+    begin
     p:=ParamStr(i);
-    //writeln('Param: ',i,' ',p);
     if p='' then
       continue
-    else if p='-v' then begin
-      writeln('instantfpc '+Version);
-      Halt(1);
-    end
-    else if p='-h' then begin
-      writeln('instantfpc '+Version);
-      writeln;
-      writeln('instantfpc -h');
-      writeln('      This help message.');
-      writeln;
-      writeln('instantfpc -v');
-      writeln('      Print version and exit.');
-      writeln;
-      writeln('instantfpc [compiler options] <source file> [program parameters]');
-      writeln('      Compiles source and runs program.');
-      writeln('      Source is compared with the cache. If cache is not valid then');
-      writeln('      source is copied to cache with the shebang line commented and');
-      writeln('      cached source is compiled.');
-      writeln('      If compilation fails the fpc output is written to stdout and');
-      writeln('      instantfpc exits with error code 1.');
-      writeln('      If compilation was successful the program is executed.');
-      writeln('      If the compiler options contains -B the program is always');
-      writeln('      compiled.');
-      writeln;
-      writeln('instantfpc --get-cache');
-      writeln('      Prints cache directory to stdout.');
-      writeln;
-      writeln('instantfpc --compiler=<path to compiler>');
-      writeln('      Normally fpc is searched in PATH and used as compiler.');
-      writeln;
-      writeln('Normal usage is to add as first line ("shebang") "#!/usr/bin/instantfpc"');
-      writeln('to a program source file. Then you can execute the source like a script.');
-      Halt(0);
-    end else if p='--get-cache' then begin
-      CacheDir:=GetCacheDir;
-      write(CacheDir);
-      Halt(0);
-    end else if (p[1]<>'-') then begin
-      // the first non flag parameter is the file name of the script
-      // followed by the parameters for the script
-      Filename:=p;
-      break;
-    end;
+    else 
+      begin
+      if (I<>1) then
+        begin
+        if InterpretParam(p) then
+          Break;
+        end  
+      else
+        begin  
+        // The linux kernel passes the whole shebang line as 1 argument. 
+        // We must parse and split it ourselves.
+        Repeat
+          J:=Pos(' ',P);
+          if (J=0) then
+            J:=Length(P)+1;
+          if InterpretParam(Copy(P,1,J-1)) then 
+            Break;
+          Delete(P,1,J);
+        Until (P='');
+        if (FileName<>'') then 
+          Break;
+        end;
+      end;  
   end;
-  if Filename='' then begin
+  if (Filename='') then 
+    begin
     writeln('missing source file');
     Halt(1);
-  end;
-
+    end;
   CheckSourceName(Filename);
 
   Src:=TStringList.Create;
@@ -105,6 +164,9 @@ begin
 
     // check cache
     CacheFilename:=CacheDir+ExtractFileName(Filename);
+    E:=LowerCase(ExtractFileExt(CacheFileName));
+    if (E<>'.pp') and (E<>'.pas') and (E<>'.lpr') then
+      CacheFileName:=CacheFileName+'.pas';
     ExeExt:='';
     OutputFilename:=CacheDir+ChangeFileExt(ExtractFileName(Filename),ExeExt);
     if not IsCacheValid(Src,CacheFilename,OutputFilename) then begin

utils/instantfpc/instantfptools.pas

@@ -4,10 +4,10 @@ unit InstantFPTools;
 
 {$define UseFpExecV}
 
-{$ifdef MSWINDOWS}
+{$ifdef WINDOWS}
   {$undef UseFpExecV}
   {$define HASEXEEXT}
-{$endif MSWINDOWS}
+{$endif WINDOWS}
 {$ifdef go32v2}
   {$undef UseFpExecV}
   {$define HASEXEEXT}
@@ -24,15 +24,21 @@ uses
 procedure CheckSourceName(const Filename: string);
 procedure CommentShebang(Src: TStringList);
 function GetCacheDir: string;
+procedure SetCacheDir(AValue : string);
 function IsCacheValid(Src: TStringList;
                       const CachedSrcFile, CachedExeFile: string): boolean;
 procedure Compile(const CacheFilename, OutputFilename: string);
 function GetCompiler: string;
+procedure SetCompiler(AValue : string); 
 function GetCompilerParameters(const SrcFilename, OutputFilename: string): string;
 procedure Run(const Filename: string);
 
 implementation
 
+Var
+  CmdCacheDir : String;
+  CmdCompiler : String;
+  
 procedure AddParam(p: string; var Line: string);
 begin
   if p='' then exit;
@@ -49,7 +55,7 @@ begin
   // avoid name clashes
   Ext:=lowercase(ExtractFileExt(Filename));
   if (Ext<>'') and (Ext<>'.pas') and (Ext<>'.pp') and (Ext<>'.p')
-  and (Ext<>'.lpr') and (Ext<>'.txt') and (Ext<>'.sh')
+  and (Ext<>'.lpr') and (Ext<>'.txt') and (Ext<>'.sh') and (Ext<>'.cgi')
   then begin
     writeln('invalid source extension ',Ext);
     Halt(1);
@@ -71,14 +77,26 @@ begin
   Src[0]:=copy(Line,1,i-1)+'//'+copy(Line,i,length(Line));
 end;
 
+
+procedure SetCacheDir(AValue : string);
+
+begin
+  CmdCacheDir:=AValue;
+end;
+
 function GetCacheDir: string;
 begin
-  Result:=GetEnvironmentVariable('INSTANTFPCCACHE');
-  if Result='' then begin
-    Result:=GetEnvironmentVariable('HOME');
-    if Result<>'' then
-      Result:=IncludeTrailingPathDelimiter(Result)+'.cache'+PathDelim+'instantfpc';
-  end;
+  Result:=CmdCacheDir;
+  if (Result='') then 
+    begin
+    Result:=GetEnvironmentVariable('INSTANTFPCCACHE');
+    if Result='' then 
+      begin
+      Result:=GetEnvironmentVariable('HOME');
+      if Result<>'' then
+        Result:=IncludeTrailingPathDelimiter(Result)+'.cache'+PathDelim+'instantfpc';
+      end;
+    end;  
   if Result='' then begin
     writeln('missing environment variable: HOME or INSTANTFPCCACHE');
     Halt(1);
@@ -113,9 +131,14 @@ begin
   {$ENDIF}
 end;
 
+procedure SetCompiler(AValue : string); 
+
+begin
+  CmdCompiler:=AValue;
+end;
+
 function GetCompiler: string;
-const
-  CompilerParam = '--compiler=';
+
 var
   Path: String;
   p: Integer;
@@ -124,28 +147,28 @@ var
   CompFile: String;
   i: Integer;
   Param: String;
+  
 begin
-  for i:=1 to Paramcount do begin
-    Param:=ParamStr(i);
-    if (Param='') or (Param[1]<>'-') then break;
-    if copy(Param,1,length(CompilerParam))=CompilerParam then begin
-      CompFile:=copy(Param,length(CompilerParam)+1,length(Param));
-      Result:=ExpandFileName(CompFile);
-      if not FileExists(Result) then begin
-        writeln('Error: '+CompFile+' not found, check the ',CompilerParam,' parameter.');
-        Halt(1);
+  Result:=CmdCompiler;
+  if (Result<>'') then
+    begin
+    Result:=ExpandFileName(Result);
+    if not FileExists(Result) then 
+      begin
+      writeln('Error: '+Result+' not found, check the --compiler parameter.');
+      Halt(1);
       end;
-      exit;
+    exit;
     end;
-  end;
 
   {$IFDEF Windows}
   CompFile:='fpc.exe';
   {$ELSE}
   CompFile:='fpc';
   {$ENDIF}
+  Result:=ExeSearch(CompFile);
   Path:=GetEnvironmentVariable('PATH');
-  if PATH<>'' then begin
+{  if PATH<>'' then begin
     p:=1;
     while p<=length(Path) do begin
       StartPos:=p;
@@ -158,8 +181,12 @@ begin
       inc(p);
     end;
   end;
-  writeln('Error: '+CompFile+' not found in PATH');
-  Halt(1);
+}
+  if (Result='') then
+    begin
+    writeln('Error: '+CompFile+' not found in PATH');
+    Halt(1);
+    end;
 end;
 
 procedure Compile(const CacheFilename, OutputFilename: string);
@@ -204,13 +231,17 @@ function GetCompilerParameters(const SrcFilename, OutputFilename: string): strin
 }
 var
   p: String;
+  i : integer;
 begin
   Result:='';
-  if (Paramcount>0) then begin
-    p:=ParamStr(1);
-    if (p<>'') and (p[1]='-') then
-      Result:=p; // copy compile params from the script
-  end;
+  I:=1;
+  While (I<=ParamCount) and (Copy(ParamStr(i),1,1)='-') do
+    begin
+    p:=ParamStr(i);
+    if (Copy(p,1,1)='-') and (copy(p,1,2)<>'--') then
+      AddParam(P,Result);
+    inc(I);  
+    end;
   AddParam('-o'+OutputFilename {$IFDEF HASEXEEXT} + '.exe' {$ENDIF},Result);
   AddParam(SrcFilename,Result);
 end;