paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-01 00:42:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

rtl:

Browse Source 
- replace ifndef ver2_4 with ifdef FPC_HAS_CPSTRING for places with TextRec.CodePage access
  - convert codepages for Read and Write text file operations

git-svn-id: trunk@19545 -
This commit is contained in:
paul 2011-10-25 08:40:49 +00:00
parent ef0c4a1e5c
commit b7185a554c
3 changed files with 60 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
rtl/inc/text.inc
View File

@ -146,11 +146,11 @@ Begin
TextRec(t).mode:=mode; TextRec(t).mode:=mode;
TextRec(t).bufpos:=0; TextRec(t).bufpos:=0;
TextRec(t).bufend:=0; TextRec(t).bufend:=0;
{$ifndef ver2_4} {$ifdef FPC_HAS_CPSTRING}
{ if no codepage is yet assigned then assign default ansi codepage } { if no codepage is yet assigned then assign default ansi codepage }
if TextRec(t).CodePage=CP_ACP then if TextRec(t).CodePage=CP_ACP then
TextRec(t).CodePage:=DefaultSystemCodePage; TextRec(t).CodePage:=DefaultSystemCodePage;
{$endif ver2_4} {$endif}
FileFunc(TextRec(t).OpenFunc)(TextRec(t)); FileFunc(TextRec(t).OpenFunc)(TextRec(t));
{ reset the mode to closed when an error has occured } { reset the mode to closed when an error has occured }
if InOutRes<>0 then if InOutRes<>0 then
@ -448,18 +448,18 @@ End;
function GetTextCodePage(var T: Text): TSystemCodePage; function GetTextCodePage(var T: Text): TSystemCodePage;
begin begin
{$ifndef ver2_4} {$ifdef FPC_HAS_CPSTRING}
GetTextCodePage:=TextRec(T).CodePage; GetTextCodePage:=TextRec(T).CodePage;
{$else} {$else}
GetTextCodePage:=0; GetTextCodePage:=0;
{$endif ver2_4} {$endif}
end; end;
procedure SetTextCodePage(var T: Text; CodePage: TSystemCodePage); procedure SetTextCodePage(var T: Text; CodePage: TSystemCodePage);
begin begin
{$ifndef ver2_4} {$ifdef FPC_HAS_CPSTRING}
TextRec(T).CodePage:=CodePage; TextRec(T).CodePage:=CodePage;
{$endif ver2_4} {$endif}
end; end;
@ -691,7 +691,8 @@ Procedure fpc_Write_Text_AnsiStr (Len : Longint; Var f : Text; const S : RawByte
Writes a AnsiString to the Text file T Writes a AnsiString to the Text file T
} }
var var
SLen : longint; SLen: longint;
a: RawByteString;
begin begin
If (InOutRes<>0) then If (InOutRes<>0) then
exit; exit;
@ -702,7 +703,14 @@ begin
If Len>SLen Then If Len>SLen Then
fpc_WriteBlanks(f,Len-SLen); fpc_WriteBlanks(f,Len-SLen);
if slen > 0 then if slen > 0 then
fpc_WriteBuffer(f,PChar(S)^,SLen); begin
{$ifdef FPC_HAS_CPSTRING}
a:=fpc_AnsiStr_To_AnsiStr(S,TextRec(f).CodePage);
fpc_WriteBuffer(f,PAnsiChar(a)^,Length(a));
{$else}
fpc_WriteBuffer(f,PAnsiChar(s)^,SLen);
{$endif}
end;
end; end;
fmInput: InOutRes:=105 fmInput: InOutRes:=105
else InOutRes:=103; else InOutRes:=103;
@ -716,8 +724,8 @@ Procedure fpc_Write_Text_UnicodeStr (Len : Longint; Var f : Text; const S : Unic
Writes a UnicodeString to the Text file T Writes a UnicodeString to the Text file T
} }
var var
SLen : longint; SLen: longint;
a: ansistring; a: RawByteString;
begin begin
If (pointer(S)=nil) or (InOutRes<>0) then If (pointer(S)=nil) or (InOutRes<>0) then
exit; exit;
@ -727,9 +735,13 @@ begin
SLen:=Length(s); SLen:=Length(s);
If Len>SLen Then If Len>SLen Then
fpc_WriteBlanks(f,Len-SLen); fpc_WriteBlanks(f,Len-SLen);
{$ifdef FPC_HAS_CPSTRING}
WideStringManager.Unicode2AnsiMoveProc(PUnicodeChar(S),a,TextRec(f).CodePage,SLen);
{$else}
a:=s; a:=s;
{$endif FPC_HAS_CPSTRING}
{ length(a) can be > slen, e.g. after utf-16 -> utf-8 } { length(a) can be > slen, e.g. after utf-16 -> utf-8 }
fpc_WriteBuffer(f,pchar(a)^,length(a)); fpc_WriteBuffer(f,PAnsiChar(a)^,Length(a));
end; end;
fmInput: InOutRes:=105 fmInput: InOutRes:=105
else InOutRes:=103; else InOutRes:=103;
@ -744,8 +756,8 @@ Procedure fpc_Write_Text_WideStr (Len : Longint; Var f : Text; const S : WideStr
Writes a WideString to the Text file T Writes a WideString to the Text file T
} }
var var
SLen : longint; SLen: longint;
a: ansistring; a: RawByteString;
begin begin
If (pointer(S)=nil) or (InOutRes<>0) then If (pointer(S)=nil) or (InOutRes<>0) then
exit; exit;
@ -755,9 +767,13 @@ begin
SLen:=Length(s); SLen:=Length(s);
If Len>SLen Then If Len>SLen Then
fpc_WriteBlanks(f,Len-SLen); fpc_WriteBlanks(f,Len-SLen);
{$ifdef FPC_HAS_CPSTRING}
widestringmanager.Wide2AnsiMoveProc(PWideChar(s), a, TextRec(f).CodePage, SLen);
{$else}
a:=s; a:=s;
{$endif}
{ length(a) can be > slen, e.g. after utf-16 -> utf-8 } { length(a) can be > slen, e.g. after utf-16 -> utf-8 }
fpc_WriteBuffer(f,pchar(a)^,length(a)); fpc_WriteBuffer(f,PAnsiChar(a)^,Length(a));
end; end;
fmInput: InOutRes:=105 fmInput: InOutRes:=105
else InOutRes:=103; else InOutRes:=103;
@ -1006,7 +1022,7 @@ End;
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS} {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_Write_Text_WideChar(Len : Longint;var t : Text;c : WideChar); iocheck; compilerproc; Procedure fpc_Write_Text_WideChar(Len : Longint;var t : Text;c : WideChar); iocheck; compilerproc;
var var
a : ansistring; a: RawByteString;
Begin Begin
If (InOutRes<>0) then If (InOutRes<>0) then
exit; exit;
@ -1023,8 +1039,12 @@ Begin
If TextRec(t).BufPos>=TextRec(t).BufSize Then If TextRec(t).BufPos>=TextRec(t).BufSize Then
FileFunc(TextRec(t).InOutFunc)(TextRec(t)); FileFunc(TextRec(t).InOutFunc)(TextRec(t));
{ a widechar can be translated into more than a single ansichar } { a widechar can be translated into more than a single ansichar }
{$ifdef FPC_HAS_CPSTRING}
widestringmanager.Wide2AnsiMoveProc(@c,a,TextRec(t).CodePage,1);
{$else}
a:=c; a:=c;
fpc_WriteBuffer(t,pchar(a)^,length(a)); {$endif}
fpc_WriteBuffer(t,PAnsiChar(a)^,Length(a));
End; End;
{$endif FPC_HAS_FEATURE_WIDESTRINGS} {$endif FPC_HAS_FEATURE_WIDESTRINGS}
@ -1323,7 +1343,8 @@ Begin
// Set actual length // Set actual length
SetLength(s,Slen); SetLength(s,Slen);
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
SetCodePage(s,cp,false); SetCodePage(s,TextRec(f).CodePage,false);
s:=fpc_AnsiStr_To_AnsiStr(s,cp);
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
End; End;
@ -1334,24 +1355,32 @@ Procedure fpc_Read_Text_AnsiStr_Intern(var f : Text;out s : RawByteString{$ifdef
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS} {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_Read_Text_UnicodeStr(var f : Text;out us : UnicodeString); iocheck; compilerproc; Procedure fpc_Read_Text_UnicodeStr(var f : Text;out us : UnicodeString); iocheck; compilerproc;
var var
s: AnsiString; s: RawByteString;
Begin Begin
// all standard input is assumed to be ansi-encoded // all standard input is assumed to be ansi-encoded
fpc_Read_Text_AnsiStr_Intern(f,RawByteString(s){$ifdef FPC_HAS_CPSTRING},DefaultSystemCodePage{$endif FPC_HAS_CPSTRING}); fpc_Read_Text_AnsiStr_Intern(f,s{$ifdef FPC_HAS_CPSTRING},DefaultSystemCodePage{$endif FPC_HAS_CPSTRING});
// Convert to unicodestring // Convert to unicodestring
{$ifdef FPC_HAS_CPSTRING}
widestringmanager.Ansi2UnicodeMoveProc(PAnsiChar(s),StringCodePage(s),us,Length(s));
{$else}
us:=s; us:=s;
{$endif}
End; End;
{$endif FPC_HAS_FEATURE_WIDESTRINGS} {$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING} {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
Procedure fpc_Read_Text_WideStr(var f : Text;out ws : WideString); iocheck; compilerproc; Procedure fpc_Read_Text_WideStr(var f : Text;out ws : WideString); iocheck; compilerproc;
var var
s: AnsiString; s: RawByteString;
Begin Begin
// all standard input is assumed to be ansi-encoded // all standard input is assumed to be ansi-encoded
fpc_Read_Text_AnsiStr_Intern(f,RawByteString(s){$ifdef FPC_HAS_CPSTRING},DefaultSystemCodePage{$endif FPC_HAS_CPSTRING}); fpc_Read_Text_AnsiStr_Intern(f,s{$ifdef FPC_HAS_CPSTRING},DefaultSystemCodePage{$endif FPC_HAS_CPSTRING});
// Convert to widestring // Convert to widestring
{$ifdef FPC_HAS_CPSTRING}
widestringmanager.Ansi2WideMoveProc(PAnsiChar(s),StringCodePage(s),ws,Length(s));
{$else}
ws:=s; ws:=s;
{$endif}
End; End;
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING} {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
@ -1395,7 +1424,11 @@ Begin
else else
begin begin
{ valid code point -> convert to widestring} { valid code point -> convert to widestring}
{$ifdef FPC_HAS_CPSTRING}
widestringmanager.Ansi2WideMoveProc(@str[0],TextRec(f).CodePage,ws,i+1);
{$else}
widestringmanager.Ansi2WideMoveProc(@str[0],DefaultSystemCodePage,ws,i+1); widestringmanager.Ansi2WideMoveProc(@str[0],DefaultSystemCodePage,ws,i+1);
{$endif}
{ has to be exactly one widechar } { has to be exactly one widechar }
if length(ws)=1 then if length(ws)=1 then
begin begin

4
rtl/inc/textrec.inc
View File

@ -42,8 +42,8 @@ type
name : array[0..textrecnamelength-1] of char; name : array[0..textrecnamelength-1] of char;
LineEnd : TLineEndStr; LineEnd : TLineEndStr;
buffer : textbuf; buffer : textbuf;
{$ifndef ver2_4} {$ifdef FPC_HAS_CPSTRING}
CodePage : TSystemCodePage; CodePage : TSystemCodePage;
{$endif ver2_4} {$endif}
End; End;

8
rtl/unix/cwstring.pp
View File

@ -878,7 +878,7 @@ begin
Result := iconv2win(ansistring(nl_langinfo(CODESET))) Result := iconv2win(ansistring(nl_langinfo(CODESET)))
end; end;
{$ifndef ver2_4} {$ifdef FPC_HAS_CPSTRING}
{$i textrec.inc} {$i textrec.inc}
procedure SetStdIOCodePage(var T: Text); inline; procedure SetStdIOCodePage(var T: Text); inline;
begin begin
@ -896,7 +896,7 @@ begin
SetStdIOCodePage(StdOut); SetStdIOCodePage(StdOut);
SetStdIOCodePage(StdErr); SetStdIOCodePage(StdErr);
end; end;
{$endif ver2_4} {$endif FPC_HAS_CPSTRING}
Procedure SetCWideStringManager; Procedure SetCWideStringManager;
Var Var
@ -961,9 +961,9 @@ initialization
{ set the DefaultSystemCodePage } { set the DefaultSystemCodePage }
DefaultSystemCodePage:=GetStandardCodePage(scpAnsi); DefaultSystemCodePage:=GetStandardCodePage(scpAnsi);
{$ifndef ver2_4} {$ifdef FPC_HAS_CPSTRING}
SetStdIOCodePages; SetStdIOCodePages;
{$endif ver2_4} {$endif FPC_HAS_CPSTRING}
{ init conversion tables for main program } { init conversion tables for main program }
InitThread; InitThread;