cwstring.pp 6.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2005 by Florian Klaempfl,
  4. member of the Free Pascal development team.
  5. libc based wide string support
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$mode objfpc}
  13. unit cwstring;
  14. interface
  15. procedure SetCWidestringManager;
  16. implementation
  17. {$linklib c}
  18. {$ifdef bsd}
  19. {$linklib iconv}
  20. {$endif bsd}
  21. Uses
  22. BaseUnix,
  23. ctypes,
  24. unix,
  25. unixtype,
  26. sysutils,
  27. initc;
  28. Const libiconvname = 'iconv';
  29. { Case-mapping "arrays" }
  30. var
  31. AnsiUpperChars: AnsiString; // 1..255
  32. AnsiLowerChars: AnsiString; // 1..255
  33. WideUpperChars: WideString; // 1..65535
  34. WideLowerChars: WideString; // 1..65535
  35. { the following declarations are from the libc unit for linux so they
  36. might be very linux centric
  37. maybe this needs to be splitted in an os depend way later }
  38. function towlower(__wc:wint_t):wint_t;cdecl;external;
  39. function towupper(__wc:wint_t):wint_t;cdecl;external;
  40. function wcscoll(__s1:pwchar_t; __s2:pwchar_t):longint;cdecl;external;
  41. const
  42. {$ifdef linux}
  43. __LC_CTYPE = 0;
  44. _NL_CTYPE_CLASS = (__LC_CTYPE shl 16);
  45. _NL_CTYPE_CODESET_NAME = (_NL_CTYPE_CLASS)+14;
  46. CODESET = _NL_CTYPE_CODESET_NAME;
  47. {$else linux}
  48. {$ifdef darwin}
  49. CODESET = 0;
  50. {$else darwin}
  51. {$ifdef FreeBSD} // actually FreeBSD5. internationalisation is afaik not default on 4.
  52. CODESET = 0;
  53. {$else freebsd}
  54. {$error lookup the value of CODESET in /usr/include/langinfo.h for your OS }
  55. {$endif FreeNSD}
  56. {$endif darwin}
  57. {$endif linux}
  58. { unicode encoding name }
  59. {$ifdef FPC_LITTLE_ENDIAN}
  60. unicode_encoding = 'UNICODELITTLE';
  61. {$else FPC_LITTLE_ENDIAN}
  62. unicode_encoding = 'UNICODEBIG';
  63. {$endif FPC_LITTLE_ENDIAN}
  64. type
  65. piconv_t = ^iconv_t;
  66. iconv_t = pointer;
  67. nl_item = longint;
  68. function nl_langinfo(__item:nl_item):pchar;cdecl;external libiconvname name 'nl_langinfo';
  69. function iconv_open(__tocode:pchar; __fromcode:pchar):iconv_t;cdecl;external libiconvname name 'iconv_open';
  70. function iconv(__cd:iconv_t; __inbuf:ppchar; __inbytesleft:psize_t; __outbuf:ppchar; __outbytesleft:psize_t):size_t;cdecl;external libiconvname name 'iconv';
  71. function iconv_close(__cd:iconv_t):longint;cdecl;external libiconvname name 'iconv_close';
  72. var
  73. iconv_ansi2wide,
  74. iconv_wide2ansi : iconv_t;
  75. procedure Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
  76. var
  77. outlength,
  78. outoffset,
  79. srclen,
  80. outleft : size_t;
  81. srcpos : pwidechar;
  82. destpos: pchar;
  83. mynil : pchar;
  84. my0 : size_t;
  85. begin
  86. mynil:=nil;
  87. my0:=0;
  88. { rought estimation }
  89. setlength(dest,len*3);
  90. outlength:=len*3;
  91. srclen:=len*2;
  92. srcpos:=source;
  93. destpos:=pchar(dest);
  94. outleft:=outlength;
  95. while iconv(iconv_wide2ansi,@srcpos,@srclen,@destpos,@outleft)=size_t(-1) do
  96. begin
  97. case fpgetCerrno of
  98. ESysEILSEQ:
  99. begin
  100. { skip and set to '?' }
  101. inc(srcpos);
  102. dec(srclen,2);
  103. destpos^:='?';
  104. inc(destpos);
  105. dec(outleft);
  106. { reset }
  107. iconv(iconv_wide2ansi,@mynil,@my0,@mynil,@my0);
  108. end;
  109. ESysE2BIG:
  110. begin
  111. outoffset:=destpos-pchar(dest);
  112. { extend }
  113. setlength(dest,outlength+len*3);
  114. inc(outleft,len*3);
  115. inc(outlength,len*3);
  116. { string could have been moved }
  117. destpos:=pchar(dest)+outoffset;
  118. end;
  119. else
  120. raise EConvertError.Create('iconv error');
  121. end;
  122. end;
  123. // truncate string
  124. setlength(dest,length(dest)-outleft);
  125. end;
  126. procedure Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
  127. var
  128. outlength,
  129. outoffset,
  130. outleft : size_t;
  131. srcpos,
  132. destpos: pchar;
  133. mynil : pchar;
  134. my0 : size_t;
  135. begin
  136. mynil:=nil;
  137. my0:=0;
  138. // extra space
  139. outlength:=len+1;
  140. setlength(dest,outlength);
  141. outlength:=len+1;
  142. srcpos:=source;
  143. destpos:=pchar(dest);
  144. outleft:=outlength*2;
  145. while iconv(iconv_ansi2wide,@srcpos,@len,@destpos,@outleft)=size_t(-1) do
  146. begin
  147. case fpgetCerrno of
  148. ESysE2BIG:
  149. begin
  150. outoffset:=destpos-pchar(dest);
  151. { extend }
  152. setlength(dest,outlength+len);
  153. inc(outleft,len*2);
  154. inc(outlength,len);
  155. { string could have been moved }
  156. destpos:=pchar(dest)+outoffset;
  157. end;
  158. else
  159. raise EConvertError.Create('iconv error');
  160. end;
  161. end;
  162. // truncate string
  163. setlength(dest,length(dest)-outleft div 2);
  164. end;
  165. function LowerWideString(const s : WideString) : WideString;
  166. var
  167. i : SizeInt;
  168. begin
  169. SetLength(result,length(s));
  170. for i:=1 to length(s) do
  171. result[i]:=WideChar(towlower(wint_t(s[i])));
  172. end;
  173. function UpperWideString(const s : WideString) : WideString;
  174. var
  175. i : SizeInt;
  176. begin
  177. SetLength(result,length(s));
  178. for i:=1 to length(s) do
  179. result[i]:=WideChar(towupper(wint_t(s[i])));
  180. end;
  181. function CompareWideString(const s1, s2 : WideString) : PtrInt;
  182. begin
  183. end;
  184. function CompareTextWideString(const s1, s2 : WideString): PtrInt;
  185. begin
  186. end;
  187. Var
  188. CWideStringManager : TWideStringManager;
  189. Procedure SetCWideStringManager;
  190. begin
  191. CWideStringManager:=widestringmanager;
  192. With CWideStringManager do
  193. begin
  194. Wide2AnsiMoveProc:=@Wide2AnsiMove;
  195. Ansi2WideMoveProc:=@Ansi2WideMove;
  196. UpperWideStringProc:=@UpperWideString;
  197. LowerWideStringProc:=@LowerWideString;
  198. {
  199. CompareWideStringProc
  200. CompareTextWideStringProc
  201. CharLengthPCharProc
  202. UpperAnsiStringProc
  203. LowerAnsiStringProc
  204. CompareStrAnsiStringProc
  205. CompareTextAnsiStringProc
  206. StrCompAnsiStringProc
  207. StrICompAnsiStringProc
  208. StrLCompAnsiStringProc
  209. StrLICompAnsiStringProc
  210. StrLowerAnsiStringProc
  211. StrUpperAnsiStringProc
  212. }
  213. end;
  214. SetWideStringManager(CWideStringManager);
  215. end;
  216. initialization
  217. SetCWideStringManager;
  218. { init conversion tables }
  219. iconv_wide2ansi:=iconv_open(nl_langinfo(CODESET),unicode_encoding);
  220. iconv_ansi2wide:=iconv_open(unicode_encoding,nl_langinfo(CODESET));
  221. finalization
  222. iconv_close(iconv_ansi2wide);
  223. end.