paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-12 20:33:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

* use the default locale for current country as the first fallback before using the 'Universal' locale if the locale set in LANG is not recognized/supported by OS/2

Browse Source 
git-svn-id: trunk@29572 -
This commit is contained in:
Tomas Hajny 2015-01-28 02:29:39 +00:00
parent 919e58fc99
commit 4cced1186d
3 changed files with 108 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
rtl/os2/sysos.inc
View File

@ -1,10 +1,9 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Free Pascal development team
Copyright (c) 2001-2015 by Free Pascal development team
This file implements all the base types and limits required
for a minimal POSIX compliant subset required to port the compiler
to a new OS.
This file contains a subset of OS/2 base types and imported OS/2 API
functions necessary for implementation of unit system.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -449,3 +448,41 @@ external 'NLS' index 6;
function DosQueryCollate (Size: cardinal; var Country: TCountryCode;
Buf: PByteArray; var TableLen: cardinal): cardinal; cdecl;
external 'NLS' index 8;
type
TTimeFmt = (Clock12, Clock24);
TCountryInfo = record
Country, CodePage: cardinal; {Country and codepage requested.}
DateFormat: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
CurrencyUnit: array [0..4] of char;
ThousandSeparator: char; {Thousands separator.}
Zero1: byte; {Always zero.}
DecimalSeparator: char; {Decimals separator,}
Zero2: byte;
DateSeparator: char; {Date separator.}
Zero3: byte;
TimeSeparator: char; {Time separator.}
Zero4: byte;
CurrencyFormat, {Bit field:
Bit 0: 0=indicator before value
1=indicator after value
Bit 1: 1=insert space after indicator.
Bit 2: 1=Ignore bit 0&1, replace
decimal separator with
indicator.}
DecimalPlace: byte; {Number of decimal places used in
currency indication.}
TimeFormat: TTimeFmt; {12/24 hour.}
Reserve1: array [0..1] of word;
DataSeparator: char; {Data list separator}
Zero5: byte;
Reserve2: array [0..4] of word;
end;
const
CurrentCountry: TCountryCode = (Country: 0; CodePage: 0);
function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
var Res: TCountryInfo; var ActualSize: cardinal): cardinal; cdecl;
external 'NLS' index 5;

4
rtl/os2/system.pas
View File

@ -200,6 +200,9 @@ type
TUniFreeLocaleObject = function (Locale_Object: TLocaleObject): longint;
cdecl;
TUniMapCtryToLocale = function (CountryCode: cardinal; LocaleName: PWideChar;
BufSize: longint): longint; cdecl;
const
DosCallsHandle: THandle = THandle (-1);
@ -224,6 +227,7 @@ var
Sys_UniStrColl: TUniStrColl;
Sys_UniCreateLocaleObject: TUniCreateLocaleObject;
Sys_UniFreeLocaleObject: TUniFreeLocaleObject;
Sys_UniMapCtryToLocale: TUniMapCtryToLocale;
{$ENDIF OS2UNICODE}

76
rtl/os2/sysucode.inc
View File

@ -187,7 +187,7 @@ const
EmptyCC: TCountryCode = (Country: 0; Codepage: 0); (* Empty = current *)
(* 819 = IBM codepage number for ISO 8859-1 used in FPC default *)
(* dummy translation between UnicodeString and AnsiString. *)
IsoCC: TCountryCode = (Country: 1; Codepage: 819); (* Empty = current *)
IsoCC: TCountryCode = (Country: 1; Codepage: 819); (* US with ISO 8859-1 *)
(* The following two arrays are initialized on startup in case that *)
(* Dummy* routines must be used. First for current codepage... *)
DBCSLeadRangesEnd: byte = 0;
@ -448,7 +448,7 @@ begin
Dec (SrcLen);
Inc (InBuf, SrcLen);
Dec (InBytesLeft, SrcLen);
DummyUniUConvToUcs := Uls_BufferFull; { According to IBM documentation Uls_Invalid and not Uls_BufferFull as returned by UniUConvFromUcs?! }
DummyUniUConvToUcs := Uls_BufferFull; { According to IBM documentation Uls_Invalid and not Uls_BufferFull is returned by UniUConvFromUcs?! }
end
else
begin
@ -462,6 +462,19 @@ begin
end;
function DummyUniMapCtryToLocale (CountryCode: cardinal; LocaleName: PWideChar;
BufSize: longint): longint; cdecl;
begin
if BufSize = 0 then
DummyUniMapCtryToLocale := Uls_Invalid
else
begin
LocaleName^ := #0;
DummyUniMapCtryToLocale := Uls_Unsupported;
end;
end;
procedure InitDBCSLeadRanges;
var
RC: cardinal;
@ -703,6 +716,8 @@ var
RC: cardinal;
CPArr: TCPArray;
ReturnedSize: cardinal;
WA: array [0..9] of WideChar; (* Even just 6 WideChars should be enough *)
CI: TCountryInfo;
begin
if InInitDefaultCP <> -1 then
begin
@ -751,22 +766,50 @@ begin
OSErrorWatch (cardinal (RCI));
DefLocObj := nil;
end;
RCI := Sys_UniCreateLocaleObject (Uni_UCS_String_Pointer, @WNull, DefLocObj);
if RCI <> 0 then
if UniAPI then (* Do not bother with the locale object otherwise *)
begin
OSErrorWatch (cardinal (RCI));
(* The locale dependent routines like comparison require a valid locale *)
(* setting, but the locale set using environment variable LANG is not *)
(* recognized by OS/2 -> we try the "Universal" locale as a fallback. *)
RCI := Sys_UniCreateLocaleObject (Uni_UCS_String_Pointer, @WUniv [0],
DefLocObj);
RCI := Sys_UniCreateLocaleObject (Uni_UCS_String_Pointer, @WNull, DefLocObj);
if RCI <> 0 then
begin
OSErrorWatch (cardinal (RCI));
DefLocObj := nil;
(* The locale dependent routines like comparison require a valid locale *)
(* setting, but the locale set using environment variable LANG is not *)
(* recognized by OS/2 -> let's try to derive the locale from country *)
RC := DosQueryCtryInfo (SizeOf (CI), EmptyCC, CI, ReturnedSize);
if RC = 0 then
begin
RCI := Sys_UniMapCtryToLocale (CI.Country, @WA [0],
SizeOf (WA) div SizeOf (WideChar));
if RCI = 0 then
begin
RCI := Sys_UniCreateLocaleObject (Uni_UCS_String_Pointer, @WA [0],
DefLocObj);
if RCI <> 0 then
begin
OSErrorWatch (cardinal (RCI));
DefLocObj := nil;
end;
end
else
OSErrorWatch (cardinal (RCI));
end
else
OSErrorWatch (RC);
if DefLocObj = nil then
(* Still no success -> let's use the "Universal" locale as a fallback. *)
begin
RCI := Sys_UniCreateLocaleObject (Uni_UCS_String_Pointer, @WUniv [0],
DefLocObj);
if RCI <> 0 then
begin
OSErrorWatch (cardinal (RCI));
DefLocObj := nil;
end;
end;
end;
end;
if not (UniAPI) then
end
else (* not UniAPI *)
ReInitDummyAnsiSupport;
InInitDefaultCP := -1;
end;
@ -1603,8 +1646,14 @@ begin
if RC = 0 then
begin
Sys_UniFreeLocaleObject := TUniFreeLocaleObject (P);
RC := DosQueryProcAddr (LibUniHandle,
OrdUniMapCtryToLocale, nil, P);
if RC = 0 then
begin
Sys_UniMapCtryToLocale := TUniMapCtryToLocale (P);
UniAPI := true;
UniAPI := true;
end;
end;
end;
end;
@ -1631,6 +1680,7 @@ begin
Sys_UniStrColl := @DummyUniStrColl;
Sys_UniCreateLocaleObject := @DummyUniCreateLocaleObject;
Sys_UniFreeLocaleObject := @DummyUniFreeLocaleObject;
Sys_UniMapCtryToLocale := @DummyUniMapCtryToLocale;
InitDummyAnsiSupport;
end;