rtl: add WideStringManager.GetStandardCodePageProc method to retrieve system ansi and console code pages

git-svn-id: trunk@19539 -

rtl/inc/ustringh.inc

@@ -50,6 +50,12 @@ procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:RawByteString;cp
 procedure DefaultAnsi2UnicodeMove(source:pchar;cp : TSystemCodePage;var dest:unicodestring;len:SizeInt);
 
 Type
+  TStandardCodePageEnum = (
+    scpAnsi,          // system Ansi code page (GetACP on windows)
+    scpConsoleInput,  // system console input code page (GetConsoleCP on windows)
+    scpConsoleOutput  // system console output code page (GetConsoleOutputCP on windows)
+  );
+
   { hooks for internationalization
     please add new procedures at the end, it makes it easier to detect new procedures }
   TUnicodeStringManager = record
@@ -101,6 +107,9 @@ Type
     LowerUnicodeStringProc : function(const S: UnicodeString): UnicodeString;
     CompareUnicodeStringProc : function(const s1, s2 : UnicodeString) : PtrInt;
     CompareTextUnicodeStringProc : function(const s1, s2 : UnicodeString): PtrInt;
+
+    { codepage retrieve function }
+    GetStandardCodePageProc: function(const stdcp: TStandardCodePageEnum): TSystemCodePage;
   end;
 
 var

rtl/inc/ustrings.inc

@@ -108,6 +108,12 @@ function DefaultCodePointLength(const Str: PChar; MaxLookAead: PtrInt): Ptrint;
   end;
 
 
+function DefaultGetStandardCodePage(const stdcp: TStandardCodePageEnum): TSystemCodePage;
+  begin
+    { don't raise an exception here. We need this for text file handling }
+    Result:=DefaultSystemCodePage;
+  end;
+
 Procedure GetUnicodeStringManager (Var Manager : TUnicodeStringManager);
 begin
   manager:=widestringmanager;
@@ -2631,5 +2637,6 @@ procedure initunicodestringmanager;
     widestringmanager.CharLengthPCharProc:=@DefaultCharLengthPChar;
     widestringmanager.CodePointLengthProc:=@DefaultCodePointLength;
 {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+    widestringmanager.GetStandardCodePageProc:=@DefaultGetStandardCodePage;
   end;
 

rtl/unix/cwstring.pp

@@ -873,6 +873,10 @@ begin
   ansi2pchar(temp,str,result);
 end;
 
+function GetStandardCodePage(const stdcp: TStandardCodePageEnum): TSystemCodePage;
+begin
+  Result := iconv2win(ansistring(nl_langinfo(CODESET)))
+end;
 
 Procedure SetCWideStringManager;
 Var
@@ -912,6 +916,8 @@ begin
       LowerUnicodeStringProc:=@LowerWideString;
       CompareUnicodeStringProc:=@CompareWideString;
       CompareTextUnicodeStringProc:=@CompareTextWideString;
+      { CodePage }
+      GetStandardCodePageProc:=@GetStandardCodePage;
     end;
   SetUnicodeStringManager(CWideStringManager);
 end;
@@ -933,7 +939,7 @@ initialization
     pointer(iconvctl):=GetProcAddress(iconvlib,iconvctlname);
 
   { set the DefaultSystemCodePage }
-  DefaultSystemCodePage:=iconv2win(ansistring(nl_langinfo(CODESET)));
+  DefaultSystemCodePage:=GetStandardCodePage(scpAnsi);
 
   { init conversion tables for main program }
   InitThread;

rtl/win/syswin.inc

@@ -671,7 +671,17 @@ var
   WStrInitTablesTable: TWStrInitTablesTable; external name 'FPC_WIDEINITTABLES';
 {$endif}
 
-function GetACP:UINT; external 'kernel32' name 'GetACP';
+function GetACP:UINT; stdcall; external 'kernel32' name 'GetACP';
+function GetConsoleCP:UINT; stdcall; external 'kernel32' name 'GetConsoleCP'; 
+
+function Win32GetStandardCodePage(const stdcp: TStandardCodePageEnum): TSystemCodePage;
+  begin
+    case stdcp of
+      scpAnsi: Result := GetACP;
+      scpConsoleInput: Result := GetConsoleCP;
+      scpConsoleOutput: Result := GetConsoleOutputCP;
+    end;
+  end;
 
 { there is a similiar procedure in sysutils which inits the fields which
   are only relevant for the sysutils units }
@@ -706,6 +716,9 @@ procedure InitWin32Widestrings;
     widestringmanager.Ansi2UnicodeMoveProc:=@Win32Ansi2UnicodeMove;
     widestringmanager.UpperUnicodeStringProc:=@Win32UnicodeUpper;
     widestringmanager.LowerUnicodeStringProc:=@Win32UnicodeLower;
+    { Codepage }
+    widestringmanager.GetStandardCodePageProc:=@Win32GetStandardCodePage;
+
     DefaultSystemCodePage:=GetACP;
     DefaultUnicodeCodePage:=CP_UTF16;
   end;

rtl/wince/system.pp

@@ -309,7 +309,9 @@ function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar;
      cdecl; external 'coredll' name 'MultiByteToWideChar';
 function WideCharToMultiByte(CodePage:UINT; dwFlags:DWORD; lpWideCharStr:PWideChar; cchWideChar:longint; lpMultiByteStr:PChar;cchMultiByte:longint; lpDefaultChar:PChar; lpUsedDefaultChar:pointer):longint;
      cdecl; external 'coredll' name 'WideCharToMultiByte';
-function GetACP:UINT; external 'coredll' name 'GetACP';
+function GetACP:UINT; cdecl; external 'coredll' name 'GetACP';
+function GetConsoleCP:UINT; cdecl; external 'coredll' name 'GetConsoleCP';
+function GetConsoleOutputCP:UINT; cdecl; external 'coredll' name 'GetConsoleOutputCP';
 
 { Returns number of characters stored to WideBuf, including null-terminator. }
 function AnsiToWideBuf(AnsiBuf: PChar; AnsiBufLen: longint; WideBuf: PWideChar; WideBufLen: longint): longint;
@@ -1604,6 +1606,15 @@ begin
   Result:=WinCEWideLower(s);
 end;
 
+function WinCEGetStandardCodePage(const stdcp: TStandardCodePageEnum): TSystemCodePage;
+  begin
+    case stdcp of
+      scpAnsi: Result := GetACP;
+      scpConsoleInput: Result := GetConsoleCP;
+      scpConsoleOutput: Result := GetConsoleOutputCP;
+    end;
+  end;
+
 { there is a similiar procedure in sysutils which inits the fields which
   are only relevant for the sysutils units }
 procedure InitWinCEWidestrings;
@@ -1617,6 +1628,9 @@ procedure InitWinCEWidestrings;
     widestringmanager.Ansi2UnicodeMoveProc:=@WinCEAnsi2UnicodeMove;
     widestringmanager.UpperUnicodeStringProc:=@WinCEUnicodeUpper;
     widestringmanager.LowerUnicodeStringProc:=@WinCEUnicodeLower;
+    { Codepage }
+    widestringmanager.GetStandardCodePageProc:=@WinCEGetStandardCodePage;
+
     DefaultSystemCodePage:=GetACP;
     DefaultUnicodeCodePage:=CP_UTF16;
   end;