From c07028fe4e843bed11d4b55f56c954849c36aefd Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 26 Nov 2003 22:17:42 +0000 Subject: [PATCH] + Merged fixbranch fixes, missing in main branch --- rtl/objpas/sysutils/sysansi.inc | 70 +++++++---- rtl/objpas/sysutils/sysstr.inc | 200 +++++++++++++++++++++++++------ rtl/objpas/sysutils/sysstrh.inc | 40 +++++-- rtl/objpas/sysutils/sysutilh.inc | 14 ++- rtl/objpas/sysutils/sysutils.inc | 51 ++++++-- 5 files changed, 295 insertions(+), 80 deletions(-) diff --git a/rtl/objpas/sysutils/sysansi.inc b/rtl/objpas/sysutils/sysansi.inc index 8c7e00282b..66fc043cbf 100644 --- a/rtl/objpas/sysutils/sysansi.inc +++ b/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 diff --git a/rtl/objpas/sysutils/sysstr.inc b/rtl/objpas/sysutils/sysstr.inc index 2a26bb030d..381844fa35 100644 --- a/rtl/objpas/sysutils/sysstr.inc +++ b/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 (I0; // 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 diff --git a/rtl/objpas/sysutils/sysstrh.inc b/rtl/objpas/sysutils/sysstrh.inc index 0f9db38312..3dd5ae9332 100644 --- a/rtl/objpas/sysutils/sysstrh.inc +++ b/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 diff --git a/rtl/objpas/sysutils/sysutilh.inc b/rtl/objpas/sysutils/sysutilh.inc index f679a86975..0d24ac5649 100644 --- a/rtl/objpas/sysutils/sysutilh.inc +++ b/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 diff --git a/rtl/objpas/sysutils/sysutils.inc b/rtl/objpas/sysutils/sysutils.inc index 8aa359f749..b78ecbae8f 100644 --- a/rtl/objpas/sysutils/sysutils.inc +++ b/rtl/objpas/sysutils/sysutils.inc @@ -381,14 +381,51 @@ begin Raise OutOfMemory; end; +{ --------------------------------------------------------------------- + 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; + +begin + Result:=True; + TPR:=TPList; + While Result and (TPR<>Nil) do + begin + Result:=TPR^.Func(); + TPR:=TPR^.NextFunc; + end; +end; + { - $Log$ - Revision 1.3 2003-11-26 20:12:08 michael - + New runerror 231 (exception stack error) and 232 (nothread support) - - Revision 1.2 2003/11/26 20:00:19 florian - * error handling for Variants improved - Revision 1.1 2003/10/06 21:01:06 peter * moved classes unit to rtl