freepascal.compiler/packages/iosxlocale/src/iosxlocale.pp

{
    This file is part of the Free Pascal packages library.
    Copyright (c) 2013 by Yury Sidorov, member of the
    Free Pascal development team

    This unit is used to get format settings of the current
    Mac OS UI locale. Works on Mac OS X 10.3 or later.

    Function CFStringToStr() has been taken from CarbonProc LCL unit.

    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.

 **********************************************************************}

{$IFNDEF FPC_DOTTEDUNITS}
unit iosxlocale;
{$ENDIF FPC_DOTTEDUNITS}

{$mode objfpc}{$H+}

interface

{$IFDEF FPC_DOTTEDUNITS}
uses
  System.SysUtils, MacOsApi.MacOSAll;
{$ELSE FPC_DOTTEDUNITS}
uses
  SysUtils, MacOSAll;
{$ENDIF FPC_DOTTEDUNITS}

procedure GetMacFormatSettings(var ASettings: TFormatSettings);

implementation

{------------------------------------------------------------------------------
  Name:    CFStringToStr
  Params:  AString  - Core Foundation string ref
           Encoding - Result data encoding format
  Returns: UTF-8 string

  Converts Core Foundation string to string
 ------------------------------------------------------------------------------}
function CFStringToStr(AString: CFStringRef): UTF8String;
  var
    Str: Pointer;
    StrSize: CFIndex;
    StrRange: CFRange;
  begin
    if AString=nil then
      begin
        Result:='';
        Exit;
      end;
  
    // Try the quick way first
    Str:=CFStringGetCStringPtr(AString, kCFStringEncodingUTF8);
    if Str<>nil then
      Result:=PAnsiChar(Str)
    else
      begin
        // if that doesn't work this will
        StrRange.location:=0;
        StrRange.length:=CFStringGetLength(AString);
    
        CFStringGetBytes(AString, StrRange, kCFStringEncodingUTF8,
          Ord('?'), False, nil, 0, StrSize{%H-});
        SetLength(Result, StrSize);
    
        if StrSize>0 then
          CFStringGetBytes(AString, StrRange, kCFStringEncodingUTF8,
            Ord('?'), False, @Result[1], StrSize, StrSize);
      end;
  end;


function StrOfChar(c: AnsiChar; Count: integer): utf8string;
  begin
    SetLength(Result, Count);
    FillChar(PAnsiChar(Result)^, Count, c);
  end;


function ConvertFormatStr(const fmt: utf8string): utf8string;
  var
    cnt: integer;
    c, q: AnsiChar;
    p: PAnsiChar;
    s: utf8string;
  begin
    Result:='';
    q:=#0;
    cnt:=1;
    p:=PAnsiChar(fmt);
    while p^<>#0 do
      begin
        s:='';
        c:=p^;
        if c in ['''', '"'] then
          begin
            if q=#0 then
              q:=c
            else
              if c=q then
                begin
                  q:=#0;
                  cnt:=1;
                end;
            s:=c;
          end
        else if q <> #0 then
          s:=c
        else
          begin
            if (p+1)^=c then
              Inc(cnt)
            else
              begin
                case c of
                  'y', 'Y':
                    begin
                      c:='y';
                      if cnt > 2 then
                        cnt:=4
                      else
                        cnt:=2;
                    end;
                  'M', 'L':
                    begin
                      c:='m';
                      if cnt > 4 then
                        cnt:=3;
                    end;
                  'd':
                    if cnt > 2 then
                      cnt:=2;
                  'E', 'e', 'c':
                    begin
                      c:='d';
                      if (cnt < 3) or (cnt > 4) then
                        cnt:=3;
                    end;
                  'a':
                    begin
                      cnt:=0;
                      s:='ampm';
                    end;
                  'h', 'H', 'k', 'K':
                    begin
                      c:='h';
                      if cnt > 2 then
                        cnt:=2;
                    end;
                  'm':
                    begin
                      c:='n';
                      if cnt>2 then
                        cnt:=2;
                    end;
                  's':
                    if cnt>2 then
                      cnt:=2;
                  'S':
                    begin
                      c:='z';
                      cnt:=1;
                    end;
                  'G','u','Q','q','w','W','D','F','g','A','z','Z','v':
                    cnt:=0;
                end;
                if cnt>0 then
                  s:=StrOfChar(c, cnt);
                cnt:=1;
              end;
          end;
        Inc(p);
        if s<>'' then
          Result:=Result+s;
      end;
  end;


procedure GetMacFormatSettings(var ASettings: TFormatSettings);
  var
    loc: CFLocaleRef;
  
    function _GetFormat(dateStyle: CFDateFormatterStyle; timeStyle: CFDateFormatterStyle; const DefFormat: utf8string): utf8string;
    var
      fmt: CFDateFormatterRef;
    begin
      Result:='';
      fmt:=CFDateFormatterCreate(nil, loc, dateStyle, timeStyle);
      if fmt <> nil then
        begin
          Result:=ConvertFormatStr(CFStringToStr(CFDateFormatterGetFormat(fmt)));
          CFRelease(fmt);
        end;
      if Result = '' then
        Result:=DefFormat;
    end;
  
    function _DateToStr(fmt: CFDateFormatterRef; const AFormat: utf8string; AYear: integer; AMonth, ADay, AHour: byte;
                        const ADefault: utf8string): utf8string;
    var
      cs: CFStringRef;
      gd: CFGregorianDate;
      at: CFAbsoluteTime;
      tz: CFTimeZoneRef;
    begin
      cs:=CFStringCreateWithCString(nil, Pointer(PAnsiChar(AFormat)), kCFStringEncodingUTF8);
      CFDateFormatterSetFormat(fmt, cs);
      CFRelease(cs);
      FillChar(gd, SIzeOf(gd), 0);
      gd.year:=AYear;
      gd.month:=AMonth;
      gd.day:=ADay;
      gd.hour:=AHour;
      tz:=CFTimeZoneCopyDefault;
      at:=CFGregorianDateGetAbsoluteTime(gd, tz);
      CFRelease(tz);
      cs:=CFDateFormatterCreateStringWithAbsoluteTime(nil, fmt, at);
      Result:=CFStringToStr(cs);
      CFRelease(cs);
      if Result = '' then
        Result:=ADefault;
    end;
  
    function _GetSeparator(dateStyle: CFDateFormatterStyle; timeStyle: CFDateFormatterStyle; DefSep: AnsiChar): AnsiChar;
    var
      fmt: CFDateFormatterRef;
      s: utf8string;
      p: PAnsiChar;
    begin
      Result:=DefSep;
      fmt:=CFDateFormatterCreate(nil, loc, dateStyle, timeStyle);
      if fmt <> nil then
        begin
          s:=_DateToStr(fmt, CFStringToStr(CFDateFormatterGetFormat(fmt)), 2000, 1, 1, 0, DefSep);
          s:=Trim(s);
          p:=PAnsiChar(s);
          while p^<>#0 do
            if (p^>' ') and (p^<'A') and not (p^ in ['0'..'9']) then
              begin
                Result:=p^;
                break;
              end
            else
              Inc(p);
          CFRelease(fmt);
        end;
    end;
  
  var
    s: utf8string;
    fmt: CFDateFormatterRef;
    i: integer;
  begin
    with ASettings do
      begin
        loc:=CFLocaleCopyCurrent;
        if loc=nil then
          exit;
        s:=CFStringToStr(CFLocaleGetValue(loc, kCFLocaleDecimalSeparator));
        if Length(s)=1 then
          DecimalSeparator:=s[1];
        s:=CFStringToStr(CFLocaleGetValue(loc, kCFLocaleGroupingSeparator));
        if Length(s)=1 then
          ThousandSeparator:=s[1]
        else
          ThousandSeparator:=' ';  // Unicode AnsiChar has been returned. Probably it is a whitespace
        CurrencyString:=CFStringToStr(CFLocaleGetValue(loc, kCFLocaleCurrencySymbol));
    
        DateSeparator:=_GetSeparator(kCFDateFormatterShortStyle, kCFDateFormatterNoStyle, DateSeparator);
        TimeSeparator:=_GetSeparator(kCFDateFormatterNoStyle, kCFDateFormatterShortStyle, TimeSeparator);
    
        LongDateFormat:=_GetFormat(kCFDateFormatterLongStyle, kCFDateFormatterNoStyle, LongDateFormat);
        ShortDateFormat:=_GetFormat(kCFDateFormatterShortStyle, kCFDateFormatterNoStyle, ShortDateFormat);
        LongTimeFormat:=_GetFormat(kCFDateFormatterNoStyle, kCFDateFormatterLongStyle, LongTimeFormat);
        ShortTimeFormat:=_GetFormat(kCFDateFormatterNoStyle, kCFDateFormatterShortStyle, ShortTimeFormat);
    
        fmt:=CFDateFormatterCreate(nil, loc, kCFDateFormatterNoStyle, kCFDateFormatterNoStyle);
        if fmt<>nil then
          begin
            for i:=1 to 12 do
              begin
                LongMonthNames[i]:=_DateToStr(fmt, 'LLLL', 2006, i, 1, 0, LongMonthNames[i]);
                ShortMonthNames[i]:=_DateToStr(fmt, 'LLL', 2006, i, 1, 0, ShortMonthNames[i]);
              end;
            for i:=1 to 7 do
              begin
                LongDayNames[i]:=_DateToStr(fmt, 'cccc', 2006, 1, i, 0, LongDayNames[i]);
                ShortDayNames[i]:=_DateToStr(fmt, 'ccc', 2006, 1, i, 0, ShortDayNames[i]);
              end;
            TimeAMString:=_DateToStr(fmt, 'a', 2006, 1, 1, 1, TimeAMString);
            TimePMString:=_DateToStr(fmt, 'a', 2006, 1, 1, 13, TimePMString);
            CFRelease(fmt);
          end;
        CFRelease(loc);
      end;
  end;

initialization
  GetMacFormatSettings(DefaultFormatSettings);

end.