Browse Source

* fixed several errors when building on unix

git-svn-id: branches/unicodestring@11689 -
florian 17 years ago
parent
commit
dba65b78b9

+ 1 - 0
.gitattributes

@@ -5392,6 +5392,7 @@ rtl/inc/varianth.inc svneol=native#text/plain
 rtl/inc/variants.pp svneol=native#text/plain
 rtl/inc/video.inc svneol=native#text/plain
 rtl/inc/videoh.inc svneol=native#text/plain
+rtl/inc/wstring22h.inc svneol=native#text/plain
 rtl/inc/wstringh.inc svneol=native#text/plain
 rtl/inc/wstrings.inc -text
 rtl/inc/wustring22.inc svneol=native#text/plain

+ 3 - 3
compiler/ncnv.pas

@@ -953,7 +953,7 @@ implementation
                    if torddef(left.resultdef).ordtype<>uwidechar then
                      procname := 'fpc_char_to_'
                    else
-                     procname := 'fpc_wchar_to_';
+                     procname := 'fpc_uchar_to_';
                    procname:=procname+tstringdef(resultdef).stringtypname;
 
                    { and the parameter }
@@ -2531,10 +2531,10 @@ implementation
       begin
         if (torddef(resultdef).ordtype=uchar) and
            (torddef(left.resultdef).ordtype=uwidechar) then
-          fname := 'fpc_wchar_to_char'
+          fname := 'fpc_uchar_to_char'
         else if (torddef(resultdef).ordtype=uwidechar) and
            (torddef(left.resultdef).ordtype=uchar) then
-          fname := 'fpc_char_to_wchar'
+          fname := 'fpc_char_to_uchar'
         else
           internalerror(2007081201);
 

+ 5 - 7
compiler/psystem.pas

@@ -157,7 +157,10 @@ implementation
         { should we give a length to the default long and ansi string definition ?? }
         clongstringtype:=tstringdef.createlong(-1);
         cansistringtype:=tstringdef.createansi;
-        cwidestringtype:=tstringdef.createwide;
+        if target_info.system in system_windows then
+          cwidestringtype:=tstringdef.createwide
+        else
+          cwidestringtype:=tstringdef.createunicode;
         cunicodestringtype:=tstringdef.createunicode;
         { length=0 for shortstring is open string (needed for readln(string) }
         openshortstringtype:=tstringdef.createshort(0);
@@ -263,12 +266,7 @@ implementation
         addtype('LongString',clongstringtype);
 {$endif support_longstring}
         addtype('AnsiString',cansistringtype);
-        { everything except windows maps widestring to unicodestring }
-        if target_info.system in system_windows then
-          addtype('WideString',cwidestringtype)
-        else
-          addtype('WideString',cunicodestringtype);
-
+        addtype('WideString',cwidestringtype);
         addtype('UnicodeString',cunicodestringtype);
 
         addtype('OpenString',openshortstringtype);

+ 63 - 18
rtl/inc/compproc.inc

@@ -123,9 +123,16 @@ procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring)
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
-procedure fpc_WideStr_sint(v : valsint; Len : SizeInt; out S : WideString); compilerproc;
-procedure fpc_WideStr_uint(v : valuint;Len : SizeInt; out S : WideString); compilerproc;
+  {$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+  procedure fpc_WideStr_sint(v : valsint; Len : SizeInt; out S : WideString); compilerproc;
+  procedure fpc_WideStr_uint(v : valuint;Len : SizeInt; out S : WideString); compilerproc;
+  {$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+  {$ifndef VER2_2}
+  procedure fpc_UnicodeStr_sint(v : valsint; Len : SizeInt; out S : UnicodeString); compilerproc;
+  procedure fpc_UnicodeStr_uint(v : valuint;Len : SizeInt; out S : UnicodeString); compilerproc;
+  {$endif VER2_2}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
+
 {$ifndef CPU64}
   procedure fpc_shortstr_qword(v : qword;len : SizeInt;out s : shortstring); compilerproc;
   procedure fpc_shortstr_int64(v : int64;len : SizeInt;out s : shortstring); compilerproc;
@@ -137,17 +144,25 @@ procedure fpc_WideStr_uint(v : valuint;Len : SizeInt; out S : WideString); compi
   {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 
   {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
-  procedure fpc_widestr_qword(v : qword;len : SizeInt;out s : widestring); compilerproc;
-  procedure fpc_widestr_int64(v : int64;len : SizeInt;out s : widestring); compilerproc;
+    {$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+    procedure fpc_widestr_qword(v : qword;len : SizeInt;out s : widestring); compilerproc;
+    procedure fpc_widestr_int64(v : int64;len : SizeInt;out s : widestring); compilerproc;
+    {$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+    {$ifndef VER2_2}
+    procedure fpc_UnicodeStr_qword(v : qword;len : SizeInt;out s : UnicodeString); compilerproc;
+    procedure fpc_UnicodeStr_int64(v : int64;len : SizeInt;out s : UnicodeString); compilerproc;
+    {$endif VER2_2}
   {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 {$endif CPU64}
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
-{$ifndef FPUNONE}
-procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : WideString); compilerproc;
-{$endif}
-{$ifdef FPC_HAS_STR_CURRENCY}
-procedure fpc_WideStr_Currency(c : Currency;len,fr : SizeInt;out s : WideString);compilerproc;
-{$endif FPC_HAS_STR_CURRENCY}
+  {$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+  {$ifndef FPUNONE}
+  procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : WideString); compilerproc;
+  {$endif}
+  {$ifdef FPC_HAS_STR_CURRENCY}
+  procedure fpc_WideStr_Currency(c : Currency;len,fr : SizeInt;out s : WideString);compilerproc;
+  {$endif FPC_HAS_STR_CURRENCY}
+  {$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 
 {$ifndef FPUNONE}
@@ -174,15 +189,28 @@ Function fpc_Val_SInt_AnsiStr (DestSize: SizeInt; Const S : AnsiString; out Code
 Function fpc_Val_Currency_AnsiStr(Const S : AnsiString; out Code : ValSInt): Currency; compilerproc;
 function fpc_Val_enum_ansistr(str2ordindex:pointer;const s:ansistring;out code:valsint):longint; compilerproc;
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
+
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
-{$ifndef FPUNONE}
-Function fpc_Val_Real_WideStr(Const S : WideString; out Code : ValSInt): ValReal; compilerproc;
-{$endif}
-Function fpc_Val_SInt_WideStr (DestSize: SizeInt; Const S : WideString; out Code : ValSInt): ValSInt; compilerproc;
-Function fpc_Val_UInt_WideStr (Const S : WideString; out Code : ValSInt): ValUInt; compilerproc;
-function fpc_val_enum_widestr(str2ordindex:pointer;const s:widestring;out code:valsint):longint;compilerproc;
-Function fpc_Val_Currency_WideStr(Const S : WideString; out Code : ValSInt): Currency; compilerproc;
+  {$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+  {$ifndef FPUNONE}
+  Function fpc_Val_Real_WideStr(Const S : WideString; out Code : ValSInt): ValReal; compilerproc;
+  {$endif}
+  Function fpc_Val_SInt_WideStr (DestSize: SizeInt; Const S : WideString; out Code : ValSInt): ValSInt; compilerproc;
+  Function fpc_Val_UInt_WideStr (Const S : WideString; out Code : ValSInt): ValUInt; compilerproc;
+  function fpc_val_Enum_WideStr (str2ordindex:pointer;const s:WideString;out code:valsint):longint;compilerproc;
+  Function fpc_Val_Currency_WideStr(Const S : WideString; out Code : ValSInt): Currency; compilerproc;
+  {$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+  {$ifndef VER2_2}
+  {$ifndef FPUNONE}
+  Function fpc_Val_Real_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): ValReal; compilerproc;
+  {$endif}
+  Function fpc_Val_SInt_UnicodeStr (DestSize: SizeInt; Const S : UnicodeString; out Code : ValSInt): ValSInt; compilerproc;
+  Function fpc_Val_UInt_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): ValUInt; compilerproc;
+  function fpc_val_Enum_UnicodeStr(str2ordindex:pointer;const s:UnicodeString;out code:valsint):longint;compilerproc;
+  Function fpc_Val_Currency_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): Currency; compilerproc;
+  {$endif VER2_2}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
+
 {$ifndef CPU64}
 Function fpc_val_int64_shortstr(Const S: ShortString; out Code: ValSInt): Int64; compilerproc;
 Function fpc_val_qword_shortstr(Const S: ShortString; out Code: ValSInt): QWord; compilerproc;
@@ -190,10 +218,18 @@ Function fpc_val_qword_shortstr(Const S: ShortString; out Code: ValSInt): QWord;
 Function fpc_Val_qword_AnsiStr (Const S : AnsiString; out Code : ValSInt): qword;compilerproc;
 Function fpc_Val_int64_AnsiStr (Const S : AnsiString; out Code : ValSInt): Int64; compilerproc;
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
+
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+{$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
 Function fpc_Val_qword_WideStr (Const S : WideString; out Code : ValSInt): qword; compilerproc;
 Function fpc_Val_int64_WideStr (Const S : WideString; out Code : ValSInt): Int64; compilerproc;
+{$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+{$ifndef VER2_2}
+Function fpc_Val_qword_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): qword; compilerproc;
+Function fpc_Val_int64_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): Int64; compilerproc;
+{$endif VER2_2}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
+
 {$endif CPU64}
 
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
@@ -247,7 +283,7 @@ Function fpc_ansistr_Unique(Var S : Pointer): Pointer; compilerproc;
                         Widestring support
 *****************************************************************************}
 
-{$if defined(WINDOWS) or defined(VER2_2)}
+{$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
 Procedure fpc_WideStr_Decr_Ref (Var S : Pointer); compilerproc;
 Procedure fpc_WideStr_Incr_Ref (Var S : Pointer); compilerproc;
@@ -306,6 +342,9 @@ procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compil
 {$endif FPC_STRTOSHORTSTRINGPROC}
 Function fpc_WChar_To_AnsiStr(const c : WideChar): AnsiString; compilerproc;
 Function fpc_WChar_To_WideStr(const c : WideChar): WideString; compilerproc;
+{$ifndef VER2_2}
+Function fpc_UChar_To_WideStr(const c : WideChar): WideString; compilerproc;
+{$endif VER2_2}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
@@ -368,6 +407,9 @@ procedure fpc_UnicodeCharArray_To_ShortStr(out res : shortstring;const arr: arra
 {$endif FPC_STRTOSHORTSTRINGPROC}
 Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; zerobased: boolean = true): AnsiString; compilerproc;
 Function fpc_UnicodeCharArray_To_UnicodeStr(const arr: array of unicodechar; zerobased: boolean = true): UnicodeString; compilerproc;
+{$ifndef VER2_2}
+Function fpc_WideCharArray_To_UnicodeStr(const arr: array of widechar; zerobased: boolean = true): UnicodeString; compilerproc;
+{$endif VER2_2}
 Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt; compilerproc;
 Function fpc_UnicodeStr_Compare_equal(const S1,S2 : UnicodeString): SizeInt; compilerproc;
 Procedure fpc_UnicodeStr_CheckZero(p : pointer); compilerproc;
@@ -375,8 +417,11 @@ Procedure fpc_UnicodeStr_CheckRange(len,index : SizeInt); compilerproc;
 Procedure fpc_UnicodeStr_SetLength (Var S : UnicodeString; l : SizeInt); compilerproc;
 Function  fpc_unicodestr_Copy (Const S : UnicodeString; Index,Size : SizeInt) : UnicodeString;compilerproc;
 function fpc_unicodestr_Unique(Var S : Pointer): Pointer; compilerproc;
+Function fpc_Char_To_UChar(const c : Char): UnicodeChar; compilerproc;
+Function fpc_UChar_To_Char(const c : UnicodeChar): Char; compilerproc;
 Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
 Function fpc_WChar_To_UnicodeStr(const c : WideChar): UnicodeString; compilerproc;
+Function fpc_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc;
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}

+ 2 - 2
rtl/inc/system.inc

@@ -335,9 +335,9 @@ function aligntoptr(p : pointer) : pointer;inline;
 {$ifdef VER2_2}
 {$i wustring22.inc}
 {$else VER2_2}
-  {$ifdef WINDOWS}
+  {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
     {$i wstrings.inc}
-  {$endif WINDOWS}
+  {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
   {$i ustrings.inc}
 {$endif VER2_2}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}

+ 4 - 4
rtl/inc/systemh.inc

@@ -345,11 +345,11 @@ Type
   PUCS2Char           = PWideChar;
   PWideString         = ^WideString;
 
-  UnicodeChar         = WideChar;
+  UnicodeChar         = type WideChar;
   PUnicodeChar        = ^UnicodeChar;
 {$ifdef VER2_2}
   { this is only to avoid too much ifdefs in the code }
-  UnicodeString       = WideString;
+  UnicodeString       = type WideString;
 {$endif VER2_2}
   PUnicodeString      = ^UnicodeString;
 
@@ -770,9 +770,9 @@ function  lowercase(const s : ansistring) : ansistring;
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
 {$ifdef VER2_2}
-{$i wstringh.inc}
+{$i wstring22h.inc}
 {$else VER2_2}
-{$i ustringh.inc}
+  {$i ustringh.inc}
   {$ifdef WINDOWS}
     {$i wstringh.inc}
   {$endif WINDOWS}

+ 69 - 0
rtl/inc/ustringh.inc

@@ -40,3 +40,72 @@ procedure UnicodeCharToStrVar(S : PUnicodeChar;out Dest : AnsiString);
 procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:ansistring;len:SizeInt);
 procedure DefaultAnsi2UnicodeMove(source:pchar;var dest:unicodestring;len:SizeInt);
 
+Type
+  { hooks for internationalization
+    please add new procedures at the end, it makes it easier to detect new procedures }
+  TUnicodeStringManager = record
+    Wide2AnsiMoveProc : procedure(source:pwidechar;var dest:ansistring;len:SizeInt);
+    Ansi2WideMoveProc : procedure(source:pchar;var dest:widestring;len:SizeInt);
+
+//    UpperUTF8 : procedure(p:PUTF8String);
+
+    UpperWideStringProc : function(const S: WideString): WideString;
+//    UpperUCS4 : procedure(p:PUCS4Char);
+//    LowerUTF8 : procedure(p:PUTF8String);
+    LowerWideStringProc : function(const S: WideString): WideString;
+//    LowerUCS4 : procedure(p:PUCS4Char);
+{
+    CompUTF8 : function(p1,p2:PUTF8String) : shortint;
+    CompUCS2 : function(p1,p2:PUCS2Char) : shortint;
+    CompUCS4 : function(p1,p2:PUC42Char) : shortint;
+}
+    CompareWideStringProc : function(const s1, s2 : WideString) : PtrInt;
+    CompareTextWideStringProc : function(const s1, s2 : WideString): PtrInt;
+    CharLengthPCharProc : function(const Str: PChar): PtrInt;
+
+    UpperAnsiStringProc : function(const s : ansistring) : ansistring;
+    LowerAnsiStringProc : function(const s : ansistring) : ansistring;
+    CompareStrAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
+    CompareTextAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
+    StrCompAnsiStringProc : function(S1, S2: PChar): PtrInt;
+    StrICompAnsiStringProc : function(S1, S2: PChar): PtrInt;
+    StrLCompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+    StrLICompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+    StrLowerAnsiStringProc : function(Str: PChar): PChar;
+    StrUpperAnsiStringProc : function(Str: PChar): PChar;
+    ThreadInitProc : procedure;
+    ThreadFiniProc : procedure;
+
+    { this is only different on windows }
+    Unicode2AnsiMoveProc : procedure(source:punicodechar;var dest:ansistring;len:SizeInt);
+    Ansi2UnicodeMoveProc : procedure(source:pchar;var dest:unicodestring;len:SizeInt);
+    UpperUnicodeStringProc : function(const S: UnicodeString): UnicodeString;
+    LowerUnicodeStringProc : function(const S: UnicodeString): UnicodeString;
+    CompareUnicodeStringProc : function(const s1, s2 : UnicodeString) : PtrInt;
+    CompareTextUnicodeStringProc : function(const s1, s2 : UnicodeString): PtrInt;
+  end;
+
+var
+  widestringmanager : TUnicodeStringManager;
+
+function UnicodeToUtf8(Dest: PChar; Source: PUnicodeChar; MaxBytes: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+function UnicodeToUtf8(Dest: PChar; MaxDestBytes: SizeUInt; Source: PUnicodeChar; SourceChars: SizeUInt): SizeUInt;
+function Utf8ToUnicode(Dest: PUnicodeChar; Source: PChar; MaxChars: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+function Utf8ToUnicode(Dest: PUnicodeChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
+function UTF8Encode(const s : Ansistring) : UTF8String; inline;
+function UTF8Encode(const s : UnicodeString) : UTF8String;
+function UTF8Decode(const s : UTF8String): UnicodeString;
+function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
+function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
+function UnicodeStringToUCS4String(const s : UnicodeString) : UCS4String;
+function UCS4StringToUnicodeString(const s : UCS4String) : UnicodeString;
+
+Procedure GetWideStringManager (Var Manager : TUnicodeStringManager);
+Procedure SetWideStringManager (Const New : TUnicodeStringManager);
+Procedure SetWideStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
+
+Procedure GetUnicodeStringManager (Var Manager : TUnicodeStringManager);
+Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager);
+Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
+
+

+ 54 - 1
rtl/inc/ustrings.inc

@@ -101,7 +101,24 @@ begin
 end;
 
 
-{****************************************************************************
+Procedure GetWideStringManager (Var Manager : TUnicodeStringManager);
+begin
+  manager:=widestringmanager;
+end;
+
+
+Procedure SetWideStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
+begin
+  Old:=widestringmanager;
+  widestringmanager:=New;
+end;
+
+
+Procedure SetWideStringManager (Const New : TUnicodeStringManager);
+begin
+  widestringmanager:=New;
+end;
+         {****************************************************************************
                     Internal functions, not in interface.
 ****************************************************************************}
 
@@ -785,6 +802,23 @@ begin
   Move(arr[0], Pointer(fpc_UnicodeCharArray_To_UnicodeStr)^,i*sizeof(UnicodeChar));
 end;
 
+
+Function fpc_WideCharArray_To_UnicodeStr(const arr: array of widechar; zerobased: boolean = true): UnicodeString; compilerproc;
+var
+  i  : SizeInt;
+begin
+  if (zerobased) then
+    begin
+      i:=IndexWord(arr,high(arr)+1,0);
+      if i = -1 then
+        i := high(arr)+1;
+    end
+  else
+    i := high(arr)+1;
+  SetLength(fpc_WideCharArray_To_UnicodeStr,i);
+  Move(arr[0], Pointer(fpc_WideCharArray_To_UnicodeStr)^,i*sizeof(WideChar));
+end;
+
 {$ifndef FPC_STRTOCHARARRAYPROC}
 
 { inside the compiler, the resulttype is modified to that of the actual }
@@ -1699,6 +1733,12 @@ begin
 end;
 
 
+function UTF8Encode(const s : Ansistring) : UTF8String; inline;
+  begin
+    Result:=UTF8Encode(UnicodeString(s));
+  end;
+
+
 function UTF8Encode(const s : UnicodeString) : UTF8String;
   var
     i : SizeInt;
@@ -1735,6 +1775,18 @@ function UTF8Decode(const s : UTF8String): UnicodeString;
   end;
 
 
+function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    Result:=Utf8Encode(s);
+  end;
+
+
+function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    Result:=Utf8Decode(s);
+  end;
+
+
 { converts an utf-16 code point or surrogate pair to utf-32 }
 function utf16toutf32(const S: UnicodeString; const index: SizeInt; out len: longint): UCS4Char; [public, alias: 'FPC_UTF16TOUTF32'];
 var
@@ -1888,3 +1940,4 @@ procedure initunicodestringmanager;
     widestringmanager.CompareUnicodeStringProc:=@CompareUnicodeString;
     widestringmanager.CompareTextUnicodeStringProc:=@CompareTextUnicodeString;
   end;
+

+ 104 - 0
rtl/inc/wstring22h.inc

@@ -0,0 +1,104 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2005 by Florian Klaempfl,
+    member of the Free Pascal development team.
+
+    This file implements support routines for WideStrings with FPC 2.2
+
+    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.
+
+ **********************************************************************}
+
+{ this file can be removed when the 2.2.x series is outdated }
+
+Procedure UniqueString (Var S : WideString);external name 'FPC_WIDESTR_UNIQUE';
+Function Pos (Const Substr : WideString; Const Source : WideString) : SizeInt;
+Function Pos (c : Char; Const s : WideString) : SizeInt;
+Function Pos (c : WideChar; Const s : WideString) : SizeInt;
+Function Pos (c : WideChar; Const s : AnsiString) : SizeInt;
+Function Pos (c : AnsiString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+Function Pos (c : WideString; Const s : AnsiString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+Function Pos (c : ShortString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+Function UpCase(const s : WideString) : WideString;
+
+Procedure Insert (Const Source : WideString; Var S : WideString; Index : SizeInt);
+Procedure Delete (Var S : WideString; Index,Size: SizeInt);
+Procedure SetString (Out S : WideString; Buf : PWideChar; Len : SizeInt);
+Procedure SetString (Out S : WideString; Buf : PChar; Len : SizeInt);
+
+function WideCharToString(S : PWideChar) : AnsiString;
+function StringToWideChar(const Src : AnsiString;Dest : PWideChar;DestSize : SizeInt) : PWideChar;
+function WideCharLenToString(S : PWideChar;Len : SizeInt) : AnsiString;
+procedure WideCharLenToStrVar(Src : PWideChar;Len : SizeInt;out Dest : AnsiString);
+procedure WideCharToStrVar(S : PWideChar;out Dest : AnsiString);
+
+procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
+procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
+
+Type
+  { hooks for internationalization
+    please add new procedures at the end, it makes it easier to detect new procedures }
+  TWideStringManager = record
+    Wide2AnsiMoveProc : procedure(source:pwidechar;var dest:ansistring;len:SizeInt);
+    Ansi2WideMoveProc : procedure(source:pchar;var dest:widestring;len:SizeInt);
+
+//    UpperUTF8 : procedure(p:PUTF8String);
+
+    UpperWideStringProc : function(const S: WideString): WideString;
+//    UpperUCS4 : procedure(p:PUCS4Char);
+//    LowerUTF8 : procedure(p:PUTF8String);
+    LowerWideStringProc : function(const S: WideString): WideString;
+//    LowerUCS4 : procedure(p:PUCS4Char);
+{
+    CompUTF8 : function(p1,p2:PUTF8String) : shortint;
+    CompUCS2 : function(p1,p2:PUCS2Char) : shortint;
+    CompUCS4 : function(p1,p2:PUC42Char) : shortint;
+}
+    CompareWideStringProc : function(const s1, s2 : WideString) : PtrInt;
+    CompareTextWideStringProc : function(const s1, s2 : WideString): PtrInt;
+    CharLengthPCharProc : function(const Str: PChar): PtrInt;
+
+    UpperAnsiStringProc : function(const s : ansistring) : ansistring;
+    LowerAnsiStringProc : function(const s : ansistring) : ansistring;
+    CompareStrAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
+    CompareTextAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
+    StrCompAnsiStringProc : function(S1, S2: PChar): PtrInt;
+    StrICompAnsiStringProc : function(S1, S2: PChar): PtrInt;
+    StrLCompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+    StrLICompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+    StrLowerAnsiStringProc : function(Str: PChar): PChar;
+    StrUpperAnsiStringProc : function(Str: PChar): PChar;
+    ThreadInitProc : procedure;
+    ThreadFiniProc : procedure;
+  end;
+
+
+function UnicodeToUtf8(Dest: PChar; Source: PWideChar; MaxBytes: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+function UnicodeToUtf8(Dest: PChar; MaxDestBytes: SizeUInt; Source: PWideChar; SourceChars: SizeUInt): SizeUInt;
+function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
+function UTF8Encode(const s : WideString) : UTF8String;
+function UTF8Decode(const s : UTF8String): WideString;
+function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
+function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
+function WideStringToUCS4String(const s : WideString) : UCS4String;
+function UCS4StringToWideString(const s : UCS4String) : WideString;
+
+{$ifdef MSWINDOWS}
+const
+  winwidestringalloc : boolean = true;
+{$endif MSWINDOWS}
+
+var
+  widestringmanager : TWideStringManager;
+
+Procedure GetWideStringManager (Var Manager : TWideStringManager);
+Procedure SetWideStringManager (Const New : TWideStringManager);
+Procedure SetWideStringManager (Const New : TWideStringManager; Var Old: TWideStringManager);
+

+ 1 - 55
rtl/inc/wstringh.inc

@@ -40,51 +40,7 @@ procedure WideCharToStrVar(S : PWideChar;out Dest : AnsiString);
 procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
 procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
 
-Type
-  { hooks for internationalization
-    please add new procedures at the end, it makes it easier to detect new procedures }
-  TUnicodeStringManager = record
-    Wide2AnsiMoveProc : procedure(source:pwidechar;var dest:ansistring;len:SizeInt);
-    Ansi2WideMoveProc : procedure(source:pchar;var dest:widestring;len:SizeInt);
-
-//    UpperUTF8 : procedure(p:PUTF8String);
-
-    UpperWideStringProc : function(const S: WideString): WideString;
-//    UpperUCS4 : procedure(p:PUCS4Char);
-//    LowerUTF8 : procedure(p:PUTF8String);
-    LowerWideStringProc : function(const S: WideString): WideString;
-//    LowerUCS4 : procedure(p:PUCS4Char);
-{
-    CompUTF8 : function(p1,p2:PUTF8String) : shortint;
-    CompUCS2 : function(p1,p2:PUCS2Char) : shortint;
-    CompUCS4 : function(p1,p2:PUC42Char) : shortint;
-}
-    CompareWideStringProc : function(const s1, s2 : WideString) : PtrInt;
-    CompareTextWideStringProc : function(const s1, s2 : WideString): PtrInt;
-    CharLengthPCharProc : function(const Str: PChar): PtrInt;
-
-    UpperAnsiStringProc : function(const s : ansistring) : ansistring;
-    LowerAnsiStringProc : function(const s : ansistring) : ansistring;
-    CompareStrAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
-    CompareTextAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
-    StrCompAnsiStringProc : function(S1, S2: PChar): PtrInt;
-    StrICompAnsiStringProc : function(S1, S2: PChar): PtrInt;
-    StrLCompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
-    StrLICompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
-    StrLowerAnsiStringProc : function(Str: PChar): PChar;
-    StrUpperAnsiStringProc : function(Str: PChar): PChar;
-    ThreadInitProc : procedure;
-    ThreadFiniProc : procedure;
-
-    { this is only different on windows }
-    Unicode2AnsiMoveProc : procedure(source:punicodechar;var dest:ansistring;len:SizeInt);
-    Ansi2UnicodeMoveProc : procedure(source:pchar;var dest:unicodestring;len:SizeInt);
-    UpperUnicodeStringProc : function(const S: UnicodeString): UnicodeString;
-    LowerUnicodeStringProc : function(const S: UnicodeString): UnicodeString;
-    CompareUnicodeStringProc : function(const s1, s2 : UnicodeString) : PtrInt;
-    CompareTextUnicodeStringProc : function(const s1, s2 : UnicodeString): PtrInt;
-  end;
-
+type
   TWideStringManager = TUnicodeStringManager;
 
 function UnicodeToUtf8(Dest: PChar; Source: PWideChar; MaxBytes: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
@@ -92,9 +48,6 @@ function UnicodeToUtf8(Dest: PChar; MaxDestBytes: SizeUInt; Source: PWideChar; S
 function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
 function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
 function UTF8Encode(const s : WideString) : UTF8String;
-function UTF8Decode(const s : UTF8String): WideString;
-function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
-function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
 function WideStringToUCS4String(const s : WideString) : UCS4String;
 function UCS4StringToWideString(const s : UCS4String) : WideString;
 
@@ -103,10 +56,3 @@ const
   winwidestringalloc : boolean = true;
 {$endif MSWINDOWS}
 
-var
-  widestringmanager : TWideStringManager;
-
-Procedure GetWideStringManager (Var Manager : TWideStringManager);
-Procedure SetWideStringManager (Const New : TWideStringManager);
-Procedure SetWideStringManager (Const New : TWideStringManager; Var Old: TWideStringManager);
-

+ 10 - 48
rtl/inc/wstrings.inc

@@ -79,24 +79,6 @@ begin
 end;
 
 
-Procedure GetWideStringManager (Var Manager : TWideStringManager);
-begin
-  manager:=widestringmanager;
-end;
-
-
-Procedure SetWideStringManager (Const New : TWideStringManager; Var Old: TWideStringManager);
-begin
-  Old:=widestringmanager;
-  widestringmanager:=New;
-end;
-
-
-Procedure SetWideStringManager (Const New : TWideStringManager);
-begin
-  widestringmanager:=New;
-end;
-
 (*
 Procedure UniqueWideString(Var S : WideString); [Public,Alias : 'FPC_WIDESTR_UNIQUE'];
 {
@@ -618,6 +600,16 @@ begin
 end;
 
 
+Function fpc_UChar_To_WideStr(const c : WideChar): WideString; compilerproc;
+{
+  Converts a WideChar to a WideString;
+}
+begin
+  Setlength (fpc_UChar_To_WideStr,1);
+  fpc_UChar_To_WideStr[1]:= c;
+end;
+
+
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
 {
@@ -1683,36 +1675,6 @@ function UTF8Encode(const s : WideString) : UTF8String;
   end;
 
 
-function UTF8Decode(const s : UTF8String): WideString;
-  var
-    i : SizeInt;
-    hs : WideString;
-  begin
-    result:='';
-    if s='' then
-      exit;
-    SetLength(hs,length(s));
-    i:=Utf8ToUnicode(PWideChar(hs),length(hs)+1,pchar(s),length(s));
-    if i>0 then
-      begin
-        SetLength(hs,i-1);
-        result:=hs;
-      end;
-  end;
-
-
-function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
-  begin
-    Result:=Utf8Encode(s);
-  end;
-
-
-function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
-  begin
-    Result:=Utf8Decode(s);
-  end;
-
-
 { converts an utf-16 code point or surrogate pair to utf-32 }
 function utf16toutf32(const S: WideString; const index: SizeInt; out len: longint): UCS4Char; [public, alias: 'FPC_WIDETOUTF32'];
 var

+ 4 - 0
rtl/linux/system.pp

@@ -329,5 +329,9 @@ begin
   { threading }
   InitSystemThreads;
   initvariantmanager;
+{$ifdef VER2_2}
   initwidestringmanager;
+{$else VER2_2}
+  initunicodestringmanager;
+{$endif VER2_2}
 end.

+ 1 - 1
rtl/objpas/sysutils/sysformt.inc

@@ -146,7 +146,7 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : SizeInt;
 {$ifdef VER2_2}
     FormatChar:=UpCase(Fmt[ChPos])[1];
 {$else VER2_2}
-    FormatChar:=UpCase(Fmt[ChPos]);
+    FormatChar:=UpCase(UnicodeChar(Fmt[ChPos]));
 {$endif VER2_2}
     if word(FormatChar)>255 then
       ReadFormat:=#255

+ 2 - 2
rtl/unix/cwstring.pp

@@ -705,7 +705,7 @@ end;
 
 Procedure SetCWideStringManager;
 Var
-  CWideStringManager : TWideStringManager;
+  CWideStringManager : TUnicodeStringManager;
 begin
   CWideStringManager:=widestringmanager;
   With CWideStringManager do
@@ -734,7 +734,7 @@ begin
       ThreadInitProc:=@InitThread;
       ThreadFiniProc:=@FiniThread;
     end;
-  SetWideStringManager(CWideStringManager);
+  SetUnicodeStringManager(CWideStringManager);
 end;
 
 

+ 2 - 1
rtl/win32/system.pp

@@ -1014,12 +1014,13 @@ procedure InitWin32Widestrings;
     widestringmanager.Ansi2WideMoveProc:=@Win32Ansi2WideMove;
     widestringmanager.UpperWideStringProc:=@Win32WideUpper;
     widestringmanager.LowerWideStringProc:=@Win32WideLower;
-
+{$ifndef VER2_2}
     { Unicode }
     widestringmanager.Unicode2AnsiMoveProc:=@Win32Unicode2AnsiMove;
     widestringmanager.Ansi2UnicodeMoveProc:=@Win32Ansi2UnicodeMove;
     widestringmanager.UpperUnicodeStringProc:=@Win32UnicodeUpper;
     widestringmanager.LowerUnicodeStringProc:=@Win32UnicodeLower;
+{$endif VER2_2}
   end;