mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-08 09:39:12 +02:00
+ Merged fixbranch fixes, missing in main branch
This commit is contained in:
michael
parent
6d09f23614
commit
c07028fe4e
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user