+ Merged fixbranch fixes, missing in main branch

rtl/objpas/sysutils/sysansi.inc

@@ -19,37 +19,63 @@
     *********************************************************************
 }
 
-function AnsiCompareFileName(const S1, S2 : Ansistring) : Longint;
-  begin
-  end;
+Function AnsiCompareFileName(const S1, S2: string): Integer;
 
-function AnsiLowerCaseFileName(const s : string) : Ansistring;
-  begin
-  end;
+begin
+  If FileNameCaseSensitive then
+    Result:=AnsiCompareStr(S1,S2) // Compare case sensitive
+  else  
+    Result:=AnsiCompareText(S1,S2); // Compare case insensitive. No MBCS yet.
+end;
 
-function AnsiUpperCaseFileName(const s : string) : Ansistring;
-  begin
-  end;
+Function SameFileName(const S1, S2: string): Boolean;
 
-function AnsiPos(const substr,s : string) : Longint;
-  begin
-  end;
+begin
+  Result:=AnsiCompareFileName(S1,S2)=0;
+end;
 
-function AnsiStrPos(str,substr : PChar) : PChar;
-  begin
-  end;
+Function AnsiLowerCaseFileName(const S: string): string;
 
-function AnsiStrRScan(Str : PChar;Chr : Char) : PChar;
-  begin
-  end;
+begin
+  Result:=AnsiLowerCase(S); // No locale support or MBCS yet.
+end;
 
-function AnsiStrScan(Str : PChar;Chr: Char) : PChar;
-  begin
-  end;
+Function AnsiUpperCaseFileName(const S: string): string;
+
+begin
+  Result:=AnsiUpperCase(S); // No locale support or MBCS yet.
+end;
+
+Function AnsiPos(const Substr, S: string): Integer;
+
+begin
+  Result:=Pos(Substr,S); // No MBCS yet.
+end;
+
+Function AnsiStrPos(Str, SubStr: PChar): PChar;
+
+begin
+  Result:=StrPos(Str,Substr);
+end;
+
+Function AnsiStrRScan(Str: PChar; Chr: Char): PChar;
+
+begin
+  Result:=StrRScan(Str,Chr);
+end;
+
+Function AnsiStrScan(Str: PChar; Chr: Char): PChar;
+
+begin
+  Result:=StrScan(Str,Chr);
+end;
 
 {
   $Log$
-  Revision 1.1  2003-10-06 21:01:06  peter
+  Revision 1.2  2003-11-26 22:17:42  michael
+  + Merged fixbranch fixes, missing in main branch
+
+  Revision 1.1  2003/10/06 21:01:06  peter
     * moved classes unit to rtl
 
   Revision 1.1  2002/10/07 19:43:24  florian

rtl/objpas/sysutils/sysstr.inc

@@ -499,33 +499,78 @@ end ;
 //  under Linux all CR characters or CR/LF combinations should be replaced with LF
 
 function AdjustLineBreaks(const S: string): string;
-var i, j, count: integer;
+
 begin
-result := '';
-i := 0;
-j := 0;
-count := Length(S);
-while i < count do begin
-   i := i + 1;
-{$ifndef Unix}
-   if (S[i] = #13) and ((i = count) or (S[i + 1] <> #10)) then
-     begin
-     result := result + Copy(S, 1 + j, i - j) + #10;
-     j := i;
-     end;
-{$else}
-   If S[i]=#13 then
-     begin
-     Result:= Result+Copy(S,J+1,i-j-1)+#10;
-     If I<>Count Then
-       If S[I+1]=#10 then inc(i);
-     J :=I;
-     end;
-{$endif}
-   end ;
-if j <> i then
-   result := result + copy(S, 1 + j, i - j);
-end ;
+  Result:=AdjustLineBreaks(S,DefaultTextLineBreakStyle);
+end;
+
+function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string;
+var
+  Source,Dest: PChar;
+  DestLen: Integer;
+  I,J,L: Longint;
+
+begin
+  Source:=Pointer(S);
+  L:=Length(S);
+  DestLen:=L;
+  I:=1;
+  while (I<=L) do
+    begin
+    case S[i] of
+      #10: if (Style=tlbsCRLF) then
+               Inc(DestLen);
+      #13: if (Style=tlbsCRLF) then
+             if (I<L) and (S[i+1]=#10) then
+               Inc(I)
+             else
+               Inc(DestLen)
+             else if (I<L) and (S[I+1]=#10) then
+               Dec(DestLen);
+    end;
+    Inc(I);
+    end;
+  if (DestLen=L) then
+    Result:=S
+  else
+    begin
+    SetLength(Result, DestLen);
+    FillChar(Result[1],DestLen,0);
+    Dest := Pointer(Result);
+    J:=0;
+    I:=0;
+    While I<L do
+      case Source[I] of
+        #10: begin
+             if Style=tlbsCRLF then
+               begin
+               Dest[j]:=#13;
+               Inc(J);
+              end;
+             Dest[J] := #10;
+             Inc(J);
+             Inc(I);
+             end;
+        #13: begin
+             if Style=tlbsCRLF then
+               begin
+               Dest[j] := #13;
+               Inc(J);
+               end;
+             Dest[j]:=#10;
+             Inc(J);
+             Inc(I);
+             if Source[I]=#10 then 
+               Inc(I);
+             end;
+      else
+        Dest[j]:=Source[i];
+        Inc(J);
+        Inc(I);
+      end;
+    end;
+end;
+
 
 {   IsValidIdent returns true if the first character of Ident is in:
     'A' to 'Z', 'a' to 'z' or '_' and the following characters are
@@ -1898,16 +1943,6 @@ for i := 0 to SizeOf(Value) shr 1 - 1 do begin
    end ;
 end ;
 
-Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
-
-begin
-  Result:=False;
-  If Index<=Length(S) then
-    Result:=Pos(S[Index],Delimiters)<>0; // Note we don't do MBCS yet
-end;
-
-
-
 Function LastDelimiter(const Delimiters, S: string): Integer;
 
 begin
@@ -1916,7 +1951,7 @@ begin
     Dec(Result);
 end;
 
-function StringReplace(const S, OldPattern, NewPattern: string;  Flags: TReplaceFlags): string;
+Function StringReplace(const S, OldPattern, NewPattern: string;  Flags: TReplaceFlags): string;
 
 var
   Srch,OldP,RemS: string; // Srch and Oldp can contain uppercase versions of S,OldPattern
@@ -1956,6 +1991,92 @@ begin
     end;
 end;
 
+Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
+
+begin
+  Result:=False;
+  If Index<=Length(S) then
+    Result:=Pos(S[Index],Delimiters)<>0; // Note we don't do MBCS yet
+end;
+
+Function ByteToCharLen(const S: string; MaxLen: Integer): Integer;
+
+begin
+  Result:=Length(S);
+  If Result>MaxLen then
+    Result:=MaxLen;
+end;
+
+Function ByteToCharIndex(const S: string; Index: Integer): Integer;
+
+begin
+  Result:=Index;
+end;
+
+
+Function CharToByteLen(const S: string; MaxLen: Integer): Integer;
+
+begin
+  Result:=Length(S);
+  If Result>MaxLen then
+    Result:=MaxLen;
+end;
+
+Function CharToByteIndex(const S: string; Index: Integer): Integer;
+
+begin
+  Result:=Index;
+end;
+
+Function ByteType(const S: string; Index: Integer): TMbcsByteType;
+
+begin
+  Result:=mbSingleByte;
+end;
+
+Function StrByteType(Str: PChar; Index: Cardinal): TMbcsByteType;
+
+begin
+  Result:=mbSingleByte;
+end;
+
+Function FindCmdLineSwitch(const Switch: string; const Chars: TSysCharSet;IgnoreCase: Boolean): Boolean;
+
+Var 
+  I,L : Integer;
+  S,T : String;
+  
+begin
+  Result:=False;
+  S:=Switch;
+  If IgnoreCase then
+    S:=UpperCase(S);
+  I:=ParamCount;
+  While (Not Result) and (I>0) do
+    begin
+    L:=Length(Paramstr(I));
+    If (L>0) and (ParamStr(I)[1] in Chars) then
+      begin
+      T:=Copy(ParamStr(I),2,L-1);
+      If IgnoreCase then
+        T:=UpperCase(T);
+      Result:=S=T;
+      end;
+    Dec(i);  
+    end;
+end;
+
+Function FindCmdLineSwitch(const Switch: string; IgnoreCase: Boolean): Boolean;
+
+begin
+  Result:=FindCmdLineSwitch(Switch,SwitchChars,IgnoreCase);
+end;
+
+Function FindCmdLineSwitch(const Switch: string): Boolean;
+
+begin
+  Result:=FindCmdLineSwitch(Switch,SwitchChars,False);
+end;
 
 {
    Case Translation Tables
@@ -2017,7 +2138,10 @@ const
 
 {
   $Log$
-  Revision 1.7  2003-11-22 17:18:53  marco
+  Revision 1.8  2003-11-26 22:17:42  michael
+  + Merged fixbranch fixes, missing in main branch
+
+  Revision 1.7  2003/11/22 17:18:53  marco
    * johill patch applied
 
   Revision 1.6  2003/11/22 16:17:26  michael

rtl/objpas/sysutils/sysstrh.inc

@@ -44,7 +44,13 @@ const
   MinDateTime: TDateTime = -657434.0;      { 01/01/0100 12:00:00.000 AM }
   MaxDateTime: TDateTime =  2958465.99999; { 12/31/9999 11:59:59.999 PM }
 
+Type
+  TTextLineBreakStyle = (tlbsLF, tlbsCRLF);   // Must move to system unit, and add Mac tlbsCR too ?
+
+Const
+  DefaultTextLineBreakStyle: TTextLineBreakStyle = {$ifdef unix} tlbsLF {$else} tlbsCRLF {$endif};
 
+               
 Const
   LeadBytes: set of Char = [];
   EmptyStr : string = '';
@@ -91,6 +97,7 @@ function QuotedStr(const S: string): string;
 function AnsiQuotedStr(const S: string; Quote: char): string;
 function AnsiExtractQuotedStr(Const Src: PChar; Quote: Char): string;
 function AdjustLineBreaks(const S: string): string;
+function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string;
 function IsValidIdent(const Ident: string): boolean;
 function IntToStr(Value: integer): string;
 {$IFNDEF VIRTUALPASCAL}
@@ -134,24 +141,32 @@ Procedure FloatToDecimal(Var Result: TFloatRec; Value: Extended; Precision, Deci
 Function FormatFloat(Const Format : String; Value : Extended) : String;
 Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
 
-{// MBCS Functions. No MBCS yet, so mostly these are calls to the regular counterparts.
+{// MBCS Functions. No MBCS yet, so mostly these are calls to the regular counterparts.}
 Type
   TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);
 
-Function AnsiCompareFileName(const S1, S2: string): Integer;
-Function SameFileName(const S1, S2: string): Boolean;
-Function AnsiLowerCaseFileName(const S: string): string;
-Function AnsiUpperCaseFileName(const S: string): string;
-Function AnsiPos(const Substr, S: string): Integer;
-Function AnsiStrPos(Str, SubStr: PChar): PChar;
-Function AnsiStrRScan(Str: PChar; Chr: Char): PChar;
-Function AnsiStrScan(Str: PChar; Chr: Char): PChar;
 Function ByteType(const S: string; Index: Integer): TMbcsByteType;
 Function StrByteType(Str: PChar; Index: Cardinal): TMbcsByteType;
 Function ByteToCharLen(const S: string; MaxLen: Integer): Integer;
 Function CharToByteLen(const S: string; MaxLen: Integer): Integer;
 Function ByteToCharIndex(const S: string; Index: Integer): Integer;
-}
+
+const
+{$ifndef unix}
+  SwitchChars = ['/','-']; 
+{$else}
+  SwitchChars = ['-'];
+{$endif}
+
+Type
+  TSysCharSet = Set of char;
+
+Function FindCmdLineSwitch(const Switch: string; const Chars: TSysCharSet;IgnoreCase: Boolean): Boolean;
+Function FindCmdLineSwitch(const Switch: string; IgnoreCase: Boolean): Boolean;
+Function FindCmdLineSwitch(const Switch: string): Boolean;
+                          
+                          
+
 {==============================================================================}
 {   extra functions                                                            }
 {==============================================================================}
@@ -162,7 +177,10 @@ function BCDToInt(Value: integer): integer;
 
 {
   $Log$
-  Revision 1.2  2003-10-07 12:02:47  marco
+  Revision 1.3  2003-11-26 22:17:42  michael
+  + Merged fixbranch fixes, missing in main branch
+
+  Revision 1.2  2003/10/07 12:02:47  marco
    * sametext and ansisametext added. (simple (ansi)comparetext wrappers)
 
   Revision 1.1  2003/10/06 21:01:06  peter

rtl/objpas/sysutils/sysutilh.inc

@@ -36,7 +36,6 @@ type
 
    tfilename = string;
 
-   tsyscharset = set of char;
    tintegerset = set of 0..sizeof(integer)*8-1;
 
    longrec = packed record
@@ -166,6 +165,14 @@ type
    procedure Beep;
    function SysErrorMessage(ErrorCode: Integer): String;
 
+type
+  TTerminateProc = function: Boolean;
+  
+  procedure AddTerminateProc(TermProc: TTerminateProc);
+  function CallTerminateProcs: Boolean;
+
+
+
 Var
    OnShowException : Procedure (Msg : ShortString);
 
@@ -219,7 +226,10 @@ Type
 
 {
   $Log$
-  Revision 1.4  2003-11-26 20:12:08  michael
+  Revision 1.5  2003-11-26 22:17:42  michael
+  + Merged fixbranch fixes, missing in main branch
+
+  Revision 1.4  2003/11/26 20:12:08  michael
   + New runerror 231 (exception stack error) and 232 (nothread support)
 
   Revision 1.3  2003/11/26 20:00:19  florian

rtl/objpas/sysutils/sysutils.inc

@@ -381,14 +381,51 @@ begin
   Raise OutOfMemory;
 end;
 
-{
-  $Log$
-  Revision 1.3  2003-11-26 20:12:08  michael
-  + New runerror 231 (exception stack error) and 232 (nothread support)
+{ ---------------------------------------------------------------------
+    Initialization/Finalization/exit code
+  ---------------------------------------------------------------------}
+  
+Type
+  PPRecord = ^TPRecord;
+  TPRecord = Record
+    Func : TTerminateProc;
+    NextFunc : PPRecord;
+  end;
+
+Const
+  TPList : PPRecord = Nil;
+
+procedure AddTerminateProc(TermProc: TTerminateProc);
+
+Var 
+  TPR : PPRecord;
+
+begin
+  New(TPR);
+  With TPR^ do
+    begin
+    NextFunc:=TPList;
+    Func:=TermProc;
+    end; 
+  TPList:=TPR;   
+end;
+
+function CallTerminateProcs: Boolean;
+
+Var
+  TPR : PPRecord;
 
-  Revision 1.2  2003/11/26 20:00:19  florian
-    * error handling for Variants improved
+begin
+  Result:=True;
+  TPR:=TPList;
+  While Result and (TPR<>Nil) do
+    begin
+    Result:=TPR^.Func();
+    TPR:=TPR^.NextFunc;
+    end; 
+end;
 
+{
   Revision 1.1  2003/10/06 21:01:06  peter
     * moved classes unit to rtl