fpc/rtl/unix/clocale.pp
marco 608498c64c * committed the fpc/ hierarchy parts of the patch in mants 18271:
Adding clocale to Solaris.

git-svn-id: trunk@16771 -
2011-01-16 10:37:02 +00:00

330 lines
11 KiB
ObjectPascal

{
This file is part of the Free Pascal run time library.
Copyright (c) 2008 by the Free Pascal development team.
Init rtl formating variables based on libc locales
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{ Initial implementation by petr kristan }
unit clocale;
{$mode objfpc}
interface
{$ifdef localedebug}
// for easier debugging, allows to print untransformed values in test
Type TOrgFormatSettings = record
ShortDateFormat,
LongDateFormat ,
ShortTimeFormat,
LongTimeFormat ,
CurrencyString1,
CurrencyString2: string;
end;
var OrgFormatSettings : TOrgFormatSettings;
{$endif}
implementation
{$linklib c}
Uses
SysUtils, unixtype, initc;
Const
{$if defined(BSD) or defined(SUNOS)}
// Darwin and FreeBSD. Note the lead underscores are added.
{$i clocale.inc}
{$else}
// checked for Linux only, but might be general glibc.
__LC_CTYPE = 0;
__LC_NUMERIC = 1;
__LC_TIME = 2;
__LC_COLLATE = 3;
__LC_MONETARY = 4;
__LC_MESSAGES = 5;
__LC_ALL = 6;
ABDAY_1 = (__LC_TIME shl 16);
DAY_1 = (ABDAY_1)+7;
ABMON_1 = (ABDAY_1)+14;
MON_1 = (ABDAY_1)+26;
AM_STR = (ABDAY_1)+38;
PM_STR = (ABDAY_1)+39;
D_T_FMT = (ABDAY_1)+40;
D_FMT = (ABDAY_1)+41;
T_FMT = (ABDAY_1)+42;
T_FMT_AMPM = (ABDAY_1)+43;
__DECIMAL_POINT = (__LC_NUMERIC shl 16);
RADIXCHAR = __DECIMAL_POINT;
__THOUSANDS_SEP = (__DECIMAL_POINT)+1;
__INT_CURR_SYMBOL = (__LC_MONETARY shl 16);
__CURRENCY_SYMBOL = (__INT_CURR_SYMBOL)+1;
__MON_DECIMAL_POINT = (__INT_CURR_SYMBOL)+2;
__MON_THOUSANDS_SEP = (__INT_CURR_SYMBOL)+3;
__MON_GROUPING = (__INT_CURR_SYMBOL)+4;
__POSITIVE_SIGN = (__INT_CURR_SYMBOL)+5;
__NEGATIVE_SIGN = (__INT_CURR_SYMBOL)+6;
__INT_FRAC_DIGITS = (__INT_CURR_SYMBOL)+7;
__FRAC_DIGITS = (__INT_CURR_SYMBOL)+8;
__P_CS_PRECEDES = (__INT_CURR_SYMBOL)+9;
__P_SEP_BY_SPACE = (__INT_CURR_SYMBOL)+10;
__N_CS_PRECEDES = (__INT_CURR_SYMBOL)+11;
__N_SEP_BY_SPACE = (__INT_CURR_SYMBOL)+12;
__P_SIGN_POSN = (__INT_CURR_SYMBOL)+13;
__N_SIGN_POSN = (__INT_CURR_SYMBOL)+14;
_NL_MONETARY_CRNCYSTR = (__INT_CURR_SYMBOL)+15;
{$endif}
function setlocale(category: cint; locale: pchar): pchar; cdecl; external clib name 'setlocale';
function nl_langinfo(__item: cint):Pchar;cdecl;external clib name 'nl_langinfo';
procedure GetFormatSettings;
function GetLocaleStr(item: cint): string;
begin
GetLocaleStr := AnsiString(nl_langinfo(item));
end;
function GetLocaleChar(item: cint): char;
begin
GetLocaleChar := nl_langinfo(item)^;
end;
procedure OmitModifiers(const s: string; var i: integer);
var
l: Integer;
begin
l := Length(s);
//possible flag, with specifier or modifier - glibc exension
while (i<=l) and (s[i] in ['0'..'9', '_', '-', '^', '#', 'E', 'O']) do
inc(i);
end;
function FindSeparator(const s: string; Def: char): char;
var
i: integer;
begin
FindSeparator := Def;
i := Pos('%', s);
if i=0 then
Exit;
inc(i);
OmitModifiers(s, i);
inc(i);
if i<=Length(s) then
FindSeparator := s[i];
end;
function TransformFormatStr(const s: string): string;
var
i, l: integer;
clock12:boolean;
begin
clock12:=false; // should ampm get appended?
TransformFormatStr := '';
i := 1;
l := Length(s);
while i<=l do begin
if s[i]='%' then begin
inc(i);
OmitModifiers(s, i);
if i>l then
Exit;
case s[i] of
'a': TransformFormatStr := TransformFormatStr + 'ddd';
'A': TransformFormatStr := TransformFormatStr + 'dddd';
'b': TransformFormatStr := TransformFormatStr + 'mmm';
'B': TransformFormatStr := TransformFormatStr + 'mmmm';
'c': TransformFormatStr := TransformFormatStr + 'c';
//'C':
'd': TransformFormatStr := TransformFormatStr + 'dd';
'D': TransformFormatStr := TransformFormatStr + 'mm"/"dd"/"yy';
'e': TransformFormatStr := TransformFormatStr + 'd';
'F': TransformFormatStr := TransformFormatStr + 'yyyy-mm-dd';
'g': TransformFormatStr := TransformFormatStr + 'yy';
'G': TransformFormatStr := TransformFormatStr + 'yyyy';
'h': TransformFormatStr := TransformFormatStr + 'mmm';
'H': TransformFormatStr := TransformFormatStr + 'hh';
'I': begin
TransformFormatStr := TransformFormatStr + 'hh';
clock12:=true;
end;
//'j':
'k': TransformFormatStr := TransformFormatStr + 'h';
'l': begin
TransformFormatStr := TransformFormatStr + 'h';
clock12:=true;
end;
'm': TransformFormatStr := TransformFormatStr + 'mm';
'M': TransformFormatStr := TransformFormatStr + 'nn';
'n': TransformFormatStr := TransformFormatStr + sLineBreak;
'p','P':
begin
TransformFormatStr := TransformFormatStr + 'ampm';
clock12:=false;
end;
'r': begin
TransformFormatStr := TransformFormatStr + 'hh:nn:ss';
clock12:=true;
end;
'R': TransformFormatStr := TransformFormatStr + 'hh:nn';
//'s':
'S': TransformFormatStr := TransformFormatStr + 'ss';
't': TransformFormatStr := TransformFormatStr + #9;
'T': TransformFormatStr := TransformFormatStr + 'hh:nn:ss';
//'u':
//'U':
//'V':
//'w':
//'W':
'x': TransformFormatStr := TransformFormatStr + 'ddddd';
'X': TransformFormatStr := TransformFormatStr + 't';
'y': TransformFormatStr := TransformFormatStr + 'yy';
'Y': TransformFormatStr := TransformFormatStr + 'yyyy';
//'z':
//'Z':
'%': TransformFormatStr := TransformFormatStr + '%';
end;
end else
TransformFormatStr := TransformFormatStr + s[i];
inc(i);
end;
i:=length(TransformFormatStr);
if clock12 and (i>0) then
begin
if transformformatstr[i]<>' ' then
TransformFormatStr := TransformFormatStr + ' ';
TransformFormatStr := TransformFormatStr + 'ampm';
end;
end;
const
// sign prec sep
NegFormatsTable: array [0..4, 0..1, 0..1] of byte = (
( (4, 15), (0, 14) ), //Parentheses surround the quantity and currency_symbol
( (5, 8), (1, 9) ), //The sign string precedes the quantity and currency_symbol
( (7, 10), (3, 11) ), //The sign string follows the quantity and currency_symbol
( (6, 13), (1, 9) ), //The sign string immediately precedes the currency_symbol
( (7, 10), (2, 12) ) //The sign string immediately follows the currency_symbol
);
var
i: integer;
prec, sep, signp: byte;
{$if defined(BSD) or defined(SUNOS)}
plocale : plconv;
{$ENDIF}
begin
setlocale(__LC_ALL,'');
for i := 1 to 12 do
begin
ShortMonthNames[i]:=GetLocaleStr(ABMON_1+i-1);
LongMonthNames[i]:=GetLocaleStr(MON_1+i-1);
end;
for i := 1 to 7 do
begin
ShortDayNames[i]:=GetLocaleStr(ABDAY_1+i-1);
LongDayNames[i]:=GetLocaleStr(DAY_1+i-1);
end;
//Date stuff
ShortDateFormat := GetLocaleStr(D_FMT);
{$ifdef localedebug}
OrgFormatSettings.ShortDateFormat:=shortdateformat;
{$endif}
DateSeparator := FindSeparator(ShortDateFormat, DateSeparator);
ShortDateFormat := TransformFormatStr(ShortDateFormat);
LongDateFormat := GetLocaleStr(D_T_FMT);
{$ifdef localedebug}
OrgFormatSettings.LongDateFormat:=longdateformat;
{$endif}
LongDateFormat := TransformFormatStr(LongDateFormat);
//Time stuff
TimeAMString := GetLocaleStr(AM_STR);
TimePMString := GetLocaleStr(PM_STR);
ShortTimeFormat := GetLocaleStr(T_FMT);
{$ifdef localedebug}
OrgFormatSettings.ShortTimeFormat:=shorttimeformat;
{$endif}
TimeSeparator := FindSeparator(ShortTimeFormat, TimeSeparator);
ShortTimeFormat := TransformFormatStr(ShortTimeFormat);
LongTimeFormat := GetLocaleStr(T_FMT_AMPM);
{$ifdef localedebug}
OrgFormatSettings.LongTimeFormat:=longtimeformat;
{$endif}
if (LongTimeFormat='') then
LongTimeFormat:=ShortTimeFormat
else
LongTimeFormat := TransformFormatStr(LongTimeFormat);
{$if defined(BSD) or defined(SUNOS)}
plocale:=localeconv;
// for these fields there is a separate BSD derived POSIX function.
if not assigned(plocale) then exit; // for now.
CurrencyString:=plocale^.currency_symbol; // int_CURR_SYMBOL (in latin chars)
if CurrencyString='' then
CurrencyString:=plocale^.int_curr_symbol;
CurrencyDecimals:=ord(plocale^.FRAC_DIGITS);
{$ifdef localedebug}
OrgFormatSettings.CurrencyString1:=plocale^.currency_symbol;
OrgFormatSettings.CurrencyString2:=plocale^.int_curr_symbol;
{$endif}
prec:=ord(plocale^.P_CS_PRECEDES);
sep:=ord(plocale^.P_SEP_BY_SPACE);
if (prec<=1) and (sep<=1) then
CurrencyFormat := byte(not boolean(prec)) + sep shl 1;
prec := ord(plocale^.N_CS_PRECEDES);
sep := ord(plocale^.N_SEP_BY_SPACE);
signp := ord(plocale^.N_SIGN_POSN);
if (signp in [0..4]) and (prec in [0, 1]) and (sep in [0, 1]) then
NegCurrFormat := NegFormatsTable[signp, prec, sep];
//Number stuff
ThousandSeparator:=plocale^.THOUSANDS_SEP[0];
{$else}
//Currency stuff
CurrencyString := GetLocaleStr(_NL_MONETARY_CRNCYSTR);
{$ifdef localedebug}
OrgFormatSettings.CurrencyString1:=currencystring;
OrgFormatSettings.CurrencyString2:='';
{$endif}
CurrencyString := Copy(CurrencyString, 2, Length(CurrencyString));
CurrencyDecimals := StrToIntDef(GetLocaleStr(__FRAC_DIGITS), CurrencyDecimals);
prec := byte(GetLocaleChar(__P_CS_PRECEDES));
sep := byte(GetLocaleChar(__P_SEP_BY_SPACE));
if (prec<=1) and (sep<=1) then
CurrencyFormat := byte(not boolean(prec)) + sep shl 1;
prec := byte(GetLocaleChar(__N_CS_PRECEDES));
sep := byte(GetLocaleChar(__N_SEP_BY_SPACE));
signp := byte(GetLocaleChar(__N_SIGN_POSN));
if (signp in [0..4]) and (prec in [0, 1]) and (sep in [0, 1]) then
NegCurrFormat := NegFormatsTable[signp, prec, sep];
//Number stuff
ThousandSeparator:=GetLocaleChar(__THOUSANDS_SEP);
Sep := ord(GetLocaleChar(__MON_THOUSANDS_SEP));
if ThousandSeparator=#0 then
ThousandSeparator := char(Sep);
{$endif}
DecimalSeparator:=GetLocaleChar(RADIXCHAR);
end;
initialization
GetFormatSettings;
end.