+ UCS4StringToWideString

+ WideStringToUCS4String
+ locale sensitive comparing of widestrings on unix

git-svn-id: trunk@1142 -

rtl/inc/wstringh.inc

@@ -53,18 +53,18 @@ Type
     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;  
+    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;
@@ -79,6 +79,8 @@ 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;
 
 var
   widestringmanager : TWideStringManager;

rtl/inc/wstrings.inc

@@ -122,8 +122,8 @@ procedure WideStringError;
   begin
     HandleErrorFrame(204,get_frame);
   end;
-  
-  
+
+
 {$ifdef WideStrDebug}
 Procedure DumpWideRec(S : Pointer);
 begin
@@ -627,7 +627,7 @@ begin
       { windows doesn't support reallocing widestrings, this code
         is anyways subject to be removed because widestrings shouldn't be
         ref. counted anymore (FK) }
-{$ifndef MSWINDOWS}       
+{$ifndef MSWINDOWS}
       else if (PWideRec(Pointer(S)-WideFirstOff)^.Ref = 1) then
         begin
           Dec(Pointer(S),WideFirstOff);
@@ -635,7 +635,7 @@ begin
               reallocmem(pointer(S), L*sizeof(WideChar)+WideRecLen);
           Inc(Pointer(S), WideFirstOff);
         end
-{$endif MSWINDOWS}        
+{$endif MSWINDOWS}
       else
         begin
           { Reallocation is needed... }
@@ -1283,6 +1283,27 @@ function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inli
   end;
 
 
+function WideStringToUCS4String(const s : WideString) : UCS4String;
+  var
+    i : SizeInt;
+  begin
+    setlength(result,length(s)+1);
+    for i:=1 to length(s) do
+      result[i-1]:=UCS4Char(s[i]);
+    result[length(s)]:=UCS4Char(0);
+  end;
+
+
+function UCS4StringToWideString(const s : UCS4String) : WideString;
+  var
+    i : SizeInt;
+  begin
+    setlength(result,length(s)-1);
+    for i:=1 to length(s)-1 do
+      result[i]:=WideChar(s[i-1]);
+  end;
+
+
 procedure unimplementedwidestring;
   begin
     HandleErrorFrame(215,get_frame);

rtl/unix/cwstring.pp

@@ -102,6 +102,8 @@ function iconv_close(__cd:iconv_t):cint;cdecl;external libiconvname name 'libico
 {$endif}
 
 var
+  iconv_ansi2ucs4,
+  iconv_ucs42ansi,
   iconv_ansi2wide,
   iconv_wide2ansi : iconv_t;
 
@@ -219,13 +221,60 @@ function UpperWideString(const s : WideString) : WideString;
   end;
 
 
+procedure Ansi2UCS4Move(source:pchar;var dest:UCS4String;len:SizeInt);
+  var
+    outlength,
+    outoffset,
+    outleft : size_t;
+    srcpos,
+    destpos: pchar;
+    mynil : pchar;
+    my0 : size_t;
+  begin
+    mynil:=nil;
+    my0:=0;
+    // extra space
+    outlength:=len+1;
+    setlength(dest,outlength);
+    outlength:=len+1;
+    srcpos:=source;
+    destpos:=pchar(dest);
+    outleft:=outlength*4;
+    while iconv(iconv_ansi2ucs4,@srcpos,@len,@destpos,@outleft)=size_t(-1) do
+      begin
+        case fpgetCerrno of
+          ESysE2BIG:
+            begin
+              outoffset:=destpos-pchar(dest);
+              { extend }
+              setlength(dest,outlength+len);
+              inc(outleft,len*4);
+              inc(outlength,len);
+              { string could have been moved }
+              destpos:=pchar(dest)+outoffset;
+            end;
+          else
+            raise EConvertError.Create('iconv error');
+        end;
+      end;
+    // truncate string
+    setlength(dest,length(dest)-outleft div 4);
+  end;
+
+
 function CompareWideString(const s1, s2 : WideString) : PtrInt;
+  var
+    hs1,hs2 : UCS4String;
   begin
+    hs1:=WideStringToUCS4String(s1);
+    hs2:=WideStringToUCS4String(s2);
+    result:=wcscoll(pwchar_t(hs1),pwchar_t(hs2));
   end;
 
 
 function CompareTextWideString(const s1, s2 : WideString): PtrInt;
   begin
+    result:=CompareWideString(UpperWideString(s1),UpperWideString(s2));
   end;
 
 
@@ -247,9 +296,10 @@ begin
 
       UpperWideStringProc:=@UpperWideString;
       LowerWideStringProc:=@LowerWideString;
+
+      CompareWideStringProc:=@CompareWideString;
+      CompareTextWideStringProc:=@CompareTextWideString;
       {
-      CompareWideStringProc
-      CompareTextWideStringProc
       CharLengthPCharProc
 
       UpperAnsiStringProc
@@ -275,6 +325,8 @@ initialization
   { init conversion tables }
   iconv_wide2ansi:=iconv_open(nl_langinfo(CODESET),unicode_encoding);
   iconv_ansi2wide:=iconv_open(unicode_encoding,nl_langinfo(CODESET));
+  iconv_ucs42ansi:=iconv_open(nl_langinfo(CODESET),'UCS4');
+  iconv_ansi2ucs4:=iconv_open('UCS4',nl_langinfo(CODESET));
 finalization
   iconv_close(iconv_ansi2wide);
 end.