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

+ support for CP_OEMCP

Browse Source 
* changed all mappings from CP_ACP to DefaultSystemCodePage to calls to the
    new TranslatePlaceholderCP() routine (which also handles CP_OEMCP)
  * removed unnecessary CP_ACP adaptations in fpc_AnsiStr_Concat_multi()
    for JVM target (now handled in the ansistring to unicodestring conversion
    routine)

git-svn-id: branches/cpstrrtl@25091 -
This commit is contained in:
Jonas Maebe 2013-07-12 17:18:24 +00:00
parent 44f4bdfb2e
commit a5273abc9c
10 changed files with 97 additions and 106 deletions

72
rtl/inc/astrings.inc
View File

@ -59,6 +59,20 @@ Const
Internal functions, not in interface.
****************************************************************************}
{$ifndef FPC_HAS_TRANSLATEPLACEHOLDERCP}
{$define FPC_HAS_TRANSLATEPLACEHOLDERCP}
function TranslatePlaceholderCP(cp: TSystemCodePage): TSystemCodePage; {$ifdef SYSTEMINLINE}inline;{$endif}
begin
TranslatePlaceholderCP:=cp;
case cp of
CP_OEMCP,
CP_ACP:
TranslatePlaceholderCP:=DefaultSystemCodePage;
end;
end;
{$endif FPC_HAS_TRANSLATEPLACEHOLDERCP}
{$ifndef FPC_HAS_PCHAR_ANSISTR_INTERN_CHARMOVE}
{$define FPC_HAS_PCHAR_ANSISTR_INTERN_CHARMOVE}
procedure fpc_pchar_ansistr_intern_charmove(const src: pchar; const srcindex: sizeint; var dst: rawbytestring; const dstindex, len: sizeint); {$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif} {$ifdef SYSTEMINLINE}inline;{$endif}
@ -207,8 +221,7 @@ begin
{$else FPC_HAS_CPSTRING}
DestCP:=StringCodePage(DestS);
{$endif FPC_HAS_CPSTRING}
if (DestCP=CP_ACP) then
DestCP:=DefaultSystemCodePage;
DestCP:=TranslatePlaceholderCP(DestCP);
{ if codepages are different then concat using unicodestring,
but avoid conversions if either addend is empty (StringCodePage will return
DefaultSystemCodePage in that case, which may differ from other addend/dest) }
@ -216,14 +229,12 @@ begin
S1CP:=DestCP
else
S1CP:=StringCodePage(S1);
if (S1CP=CP_ACP) then
S1CP:=DefaultSystemCodePage;
S1CP:=TranslatePlaceholderCP(S1CP);
if S2='' then
S2CP:=DestCP
else
S2CP:=StringCodePage(S2);
if (S2CP=CP_ACP) then
S2CP:=DefaultSystemCodePage;
S2CP:=TranslatePlaceholderCP(S2CP);
if (S1CP<>DestCP) or (S2CP<>DestCP) then
begin
ansistr_concat_complex(DestS,S1,S2,DestCP);
@ -296,15 +307,12 @@ begin
{$else FPC_HAS_CPSTRING}
DestCP:=StringCodePage(DestS);
{$endif FPC_HAS_CPSTRING}
if (DestCP=CP_ACP) then
DestCP:=DefaultSystemCodePage;
DestCP:=TranslatePlaceholderCP(DestCP);
sameCP:=true;
lowstart:=low(sarr);
for i:=lowstart to high(sarr) do
begin
tmpCP:=StringCodePage(sarr[i]);
if tmpCP=CP_ACP then
tmpCP:=DefaultSystemCodePage;
tmpCP:=TranslatePlaceholderCP(StringCodePage(sarr[i]));
if (DestCP<>tmpCp) then
begin
sameCP:=false;
@ -408,11 +416,8 @@ begin
Size:=Length(S);
if Size>0 then
begin
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
orgcp:=StringCodePage(S);
if (orgcp=CP_ACP) then
orgcp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
orgcp:=TranslatePlaceholderCP(StringCodePage(S));
if (orgcp=cp) or (orgcp=CP_NONE) then
begin
SetLength(result,Size);
@ -469,8 +474,7 @@ Var
{$endif FPC_HAS_CPSTRING}
begin
{$ifdef FPC_HAS_CPSTRING}
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
{$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING}
@ -497,8 +501,7 @@ var
{$endif FPC_HAS_CPSTRING}
begin
{$ifdef FPC_HAS_CPSTRING}
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
{$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING}
@ -527,8 +530,7 @@ begin
if L > 0 then
begin
{$ifdef FPC_HAS_CPSTRING}
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
{$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING}
@ -565,8 +567,7 @@ begin
if i > 0 then
begin
{$ifdef FPC_HAS_CPSTRING}
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
{$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING}
@ -626,12 +627,8 @@ begin
result:=Length(S1);
exit;
end;
cp1:=StringCodePage(S1);
if cp1=CP_ACP then
cp1:=DefaultSystemCodePage;
cp2:=StringCodePage(S2);
if cp2=CP_ACP then
cp2:=DefaultSystemCodePage;
cp1:=TranslatePlaceholderCP(StringCodePage(S1));
cp2:=TranslatePlaceholderCP(StringCodePage(S2));
if cp1=cp2 then
begin
Maxi:=Length(S1);
@ -690,12 +687,8 @@ begin
result:=1;
exit;
end;
cp1:=StringCodePage(S1);
if cp1=CP_ACP then
cp1:=DefaultSystemCodePage;
cp2:=StringCodePage(S2);
if cp2=CP_ACP then
cp2:=DefaultSystemCodePage;
cp1:=TranslatePlaceholderCP(StringCodePage(S1));
cp2:=TranslatePlaceholderCP(StringCodePage(S2));
if cp1=cp2 then
begin
Maxi:=Length(S1);
@ -776,8 +769,7 @@ begin
Pointer(S):=Temp;
end;
{$ifdef FPC_HAS_CPSTRING}
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
PAnsiRec(Pointer(S)-AnsiFirstOff)^.CodePage:=cp;
{$else}
PAnsiRec(Pointer(S)-AnsiFirstOff)^.CodePage:=DefaultSystemCodePage;
@ -1278,9 +1270,7 @@ begin
index := LS+1;
Dec(Index);
SetLength(Temp,Length(Source)+LS);
cp:=StringCodePage(S);
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(StringCodePage(S));
SetCodePage(Temp,cp,false);
If Index>0 then
fpc_pchar_ansistr_intern_charmove(pchar(S),0,Temp,0,Index);

22
rtl/inc/systemh.inc
View File

@ -84,6 +84,17 @@
Global Types and Constants
****************************************************************************}
{ some values which are used in RTL for TSystemCodePage type }
const
CP_ACP = 0; // default to ANSI code page
CP_OEMCP = 1; // default to OEM (console) code page
CP_UTF16 = 1200; // utf-16
CP_UTF16BE = 1201; // unicodeFFFE
CP_UTF7 = 65000; // utf-7
CP_UTF8 = 65001; // utf-8
CP_ASCII = 20127; // us-ascii
CP_NONE = $FFFF; // rawbytestring encoding
Type
{ The compiler has all integer types defined internally. Here
we define only aliases }
@ -370,17 +381,6 @@ Type
PPChar = ^PChar;
PPPChar = ^PPChar;
{ some values which are used in RTL for TSystemCodePage type }
const
CP_ACP = 0; // default to ANSI code page
CP_UTF16 = 1200; // utf-16
CP_UTF16BE = 1201; // unicodeFFFE
CP_UTF7 = 65000; // utf-7
CP_UTF8 = 65001; // utf-8
CP_ASCII = 20127; // us-ascii
CP_NONE = $FFFF; // rawbytestring encoding
type
{ AnsiChar is equivalent of Char, so we need
to use type renamings }
TAnsiChar = Char;

3
rtl/inc/text.inc
View File

@ -148,8 +148,7 @@ Begin
TextRec(t).bufend:=0;
{$ifdef FPC_HAS_CPSTRING}
{ if no codepage is yet assigned then assign default ansi codepage }
if TextRec(t).CodePage=CP_ACP then
TextRec(t).CodePage:=DefaultSystemCodePage;
TextRec(t).CodePage:=TranslatePlaceholderCP(TextRec(t).CodePage);
{$endif}
FileFunc(TextRec(t).OpenFunc)(TextRec(t));
{ reset the mode to closed when an error has occured }

10
rtl/inc/ustrings.inc
View File

@ -312,8 +312,7 @@ begin
Size:=Length(S2);
if Size>0 then
begin
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Pointer(S2)),result,cp,Size);
end;
end;
@ -334,9 +333,7 @@ begin
Size:=Length(S2);
if Size>0 then
begin
cp:=StringCodePage(S2);
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(StringCodePage(S2));
widestringmanager.Ansi2UnicodeMoveProc(PChar(S2),cp,result,Size);
end;
end;
@ -641,8 +638,7 @@ begin
{$ifndef FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING}
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
widestringmanager.Unicode2AnsiMoveProc(@c, fpc_UChar_To_AnsiStr, cp, 1);
end;
{$endif FPC_HAS_UCHAR_TO_ANSISTR}

7
rtl/inc/wstrings.inc
View File

@ -194,8 +194,7 @@ begin
Size:=Length(S2);
if Size>0 then
begin
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),result,cp,Size);
end;
end;
@ -213,9 +212,7 @@ begin
Size:=Length(S2);
if Size>0 then
begin
cp:=StringCodePage(S2);
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(StringCodePage(S2));
widestringmanager.Ansi2WideMoveProc(PChar(S2),cp,result,Size);
end;
end;

59
rtl/java/jastrings.inc
View File

@ -17,6 +17,18 @@
{ This will release some functions for special shortstring support }
{ define EXTRAANSISHORT}
{$define FPC_HAS_TRANSLATEPLACEHOLDERCP}
function TranslatePlaceholderCP(cp: TSystemCodePage): TSystemCodePage; {$ifdef SYSTEMINLINE}inline;{$endif}
begin
TranslatePlaceholderCP:=cp;
case cp of
CP_OEMCP,
CP_ACP:
TranslatePlaceholderCP:=DefaultSystemCodePage;
end;
end;
constructor AnsistringClass.Create(len: longint; cp: TSystemCodePage);
begin
fElementSize:=1;
@ -146,7 +158,7 @@ end;
function AnsistringClass.toUnicodeString: unicodestring;
begin
widestringmanager.Ansi2UnicodeMoveProc(pchar(fdata),fCodePage,result,system.length(fdata)-1);
widestringmanager.Ansi2UnicodeMoveProc(pchar(fdata),TranslatePlaceholderCP(fCodePage),result,system.length(fdata)-1);
end;
@ -302,11 +314,8 @@ begin
Size:=Length(S);
if Size>0 then
begin
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
orgcp:=StringCodePage(S);
if (orgcp=CP_ACP) then
orgcp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
orgcp:=TranslatePlaceholderCP(StringCodePage(S));
if (orgcp=cp) or (orgcp=CP_NONE) then
begin
result:=RawByteString(AnsistringClass.Create(S,cp));
@ -333,7 +342,6 @@ Var
DestCP : TSystemCodePage;
U : UnicodeString;
sameCP : Boolean;
tmpStr : RawByteString;
tmpCP : TSystemCodePage;
begin
if high(sarr)=0 then
@ -349,15 +357,12 @@ begin
{$else FPC_HAS_CPSTRING}
DestCP:=StringCodePage(DestS);
{$endif FPC_HAS_CPSTRING}
if (DestCP=CP_ACP) then
DestCP:=DefaultSystemCodePage;
DestCP:=TranslatePlaceholderCP(DestCP);
sameCP:=true;
lowstart:=low(sarr);
for i:=lowstart to high(sarr) do
begin
tmpCP:=StringCodePage(sarr[i]);
if tmpCP=CP_ACP then
tmpCP:=DefaultSystemCodePage;
tmpCP:=TranslatePlaceholderCP(StringCodePage(sarr[i]));
if (DestCP<>tmpCp) then
begin
sameCP:=false;
@ -367,17 +372,8 @@ begin
if not sameCP then
begin
U:='';
for i:=lowstart to high(sarr) do begin
tmpCP:=StringCodePage(sarr[i]);
if (tmpCP=CP_ACP) then
begin
tmpStr:=sarr[i];
SetCodePage(tmpStr,DefaultSystemCodePage,False);
U:=U+UnicodeString(tmpStr);
end
else
U:=U+UnicodeString(sarr[i]);
end;
for i:=lowstart to high(sarr) do
U:=U+UnicodeString(sarr[i]);
DestS:='';
widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(JLString(U).toCharArray),DestS,DestCP,Length(U));
@ -468,8 +464,7 @@ begin
if L > 0 then
begin
{$ifdef FPC_HAS_CPSTRING}
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
{$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING}
@ -552,10 +547,11 @@ begin
else
begin
r1:=S1;
if (cp1=CP_ACP) then
cp1:=TranslatePlaceholderCP(cp1);
if (cp1<>StringCodePage(r1)) then
SetCodePage(r1,DefaultSystemCodePage,false);
r2:=S2;
if (cp2=CP_ACP) then
if (cp2<>StringCodePage(r2)) then
SetCodePage(r2,DefaultSystemCodePage,false);
//convert them to utf8 then compare
SetCodePage(r1,65001);
@ -599,10 +595,12 @@ begin
if cp1<>cp2 then
begin
r1:=S1;
if (cp1=CP_ACP) then
cp1:=TranslatePlaceholderCP(cp1);
if (cp1<>StringCodePage(r1)) then
SetCodePage(r1,DefaultSystemCodePage,false);
r2:=S2;
if (cp2=CP_ACP) then
cp2:=TranslatePlaceholderCP(cp2);
if (cp2<>StringCodePage(r2)) then
SetCodePage(r2,DefaultSystemCodePage,false);
//convert them to utf8 then compare
SetCodePage(r1,65001);
@ -631,8 +629,7 @@ var
oldlen: longint;
result: RawByteString;
begin
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
{ no explicit reference counting possible -> can't reuse S because we don't
know how many references exist to it }
result:=RawByteString(AnsistringClass.Create(l,cp));

1
rtl/java/jsystemh_types.inc
View File

@ -295,6 +295,7 @@ Type
{ some values which are used in RTL for TSystemCodePage type }
const
CP_ACP = 0; // default to ANSI code page
CP_OEMCP = 1; // default to OEM (console) code page
CP_UTF16 = 1200; // utf-16
CP_UTF16BE = 1201; // unicodeFFFE
CP_UTF7 = 65000; // utf-7

12
rtl/java/justrings.inc
View File

@ -122,8 +122,7 @@ Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString{$ifdef FPC_HAS_CPST
Var
Size : SizeInt;
begin
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
{ avoid codepage conversion -- why isn't the result rawbytestring? }
pointer(result):=pointer(AnsistringClass.Create(s2,cp));
end;
@ -185,8 +184,7 @@ begin
if (p=nil) or
(p^=#0) then
exit;
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
pointer(result):=pointer(AnsistringClass.Create(unicodestring(p),cp));
end;
@ -317,8 +315,7 @@ var
arr: array[0..0] of unicodechar;
begin
arr[0]:=c;
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
widestringmanager.Unicode2AnsiMoveProc(punicodechar(@arr), RawByteString(fpc_UChar_To_AnsiStr), cp, 1);
end;
@ -351,8 +348,7 @@ begin
{$ifndef FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING}
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
cp:=TranslatePlaceholderCP(cp);
arr[0]:=c;
widestringmanager.Unicode2AnsiMoveProc(punicodechar(@arr[0]), fpc_UChar_To_AnsiStr, cp, 1);
end;

16
rtl/win/sysos.inc
View File

@ -318,6 +318,8 @@ threadvar
stdcall;external KernelDLL name 'GetConsoleMode';
function GetConsoleOutputCP : UINT;
stdcall; external KernelDLL name 'GetConsoleOutputCP';
function GetOEMCP: UINT;
stdcall; external KernelDLL name 'GetOEMCP';
function SysAllocStringLen(psz:pointer;len:dword):pointer;
stdcall; external 'oleaut32.dll' name 'SysAllocStringLen';
@ -392,3 +394,17 @@ threadvar
SetString(widestring(pointer(result)),PWideChar(source),length(source));
end;
{$ifndef WINCE}
{$define FPC_HAS_TRANSLATEPLACEHOLDERCP}
function TranslatePlaceholderCP(cp: TSystemCodePage): TSystemCodePage; {$ifdef SYSTEMINLINE}inline;{$endif}
begin
TranslatePlaceholderCP:=cp;
case cp of
CP_OEMCP:
TranslatePlaceholderCP:=GetOEMCP;
CP_ACP:
TranslatePlaceholderCP:=DefaultSystemCodePage;
end;
end;
{$endif not WINCE}

1
rtl/wince/system.pp
View File

@ -307,7 +307,6 @@ const
MB_COMPOSITE = 2;
MB_ERR_INVALID_CHARS = 8;
MB_USEGLYPHCHARS = 4;
CP_OEMCP = 1;
function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
cdecl; external 'coredll' name 'MultiByteToWideChar';