741f86a425
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4098 8e941d3f-bd1b-0410-a28a-d453659cc2b4
451 lines
13 KiB
ObjectPascal
451 lines
13 KiB
ObjectPascal
//ENG:Deprecated module. In future removed!!! Now all functions marked as comment.
|
||
//ENG:for revert changes remove "(*" comment.
|
||
//RUS:Устаревший модуль. В будущем будет удалён. Сейчас весь функционал просто закоментирован.
|
||
//RUS:Для отмены изменений удалите "(*" коментарии
|
||
|
||
|
||
(*
|
||
A.Voitov zprokuror(cyka)narod.ru
|
||
LAZARUS-FPC-LINUX codeset conversion routines
|
||
|
||
The goal is easy-and-on-fly *.lrs conversion from codeset used by developer to
|
||
user's system codeset without gettext, without separate message files etc.
|
||
|
||
Now I only have to set my codeset below (by default it's mine - UTF-8) -
|
||
DON'T FORGET ABOUT IT -
|
||
and call LocalizeForm('TFormClassName') right after {$I TFormClassName.lrs} -
|
||
see example below.
|
||
This way form resource file will be converted to system codeset when form is
|
||
creating.
|
||
|
||
For gtk/gnome there's only one conversion routine
|
||
function Localize(source:string):ansistring;
|
||
For gtk2 resource MUST, I guess, be converted to UTF-8 anyway (if it's not yet),
|
||
so I set current_codeset to UTF-8 with FORCE_UTF8 definition. Though if
|
||
developer's codeset is UTF-8 then no form resource conversion needed.
|
||
|
||
Localize is published function so it can be used again to convert string constants,
|
||
resource strings in most cases with no care about user's and developer's codeset.
|
||
But it's not enough sometime (file names, inifiles etc. can be wrong when gtk2
|
||
works in koi8-r locale).
|
||
That's why we've got some stuff th handle it without care.
|
||
1. First one is TIconv object (I'm not sure it's best way to do maybe it would class?
|
||
if so uncomment $DEFINE OBJ_IS_CLASS below)
|
||
2. Second are uiconv_xxx functions
|
||
They can be used to easy implement any valid conversions.
|
||
|
||
EXAMPLES:
|
||
1. Auto form conversion
|
||
- set my codeset below: {$DEFINE DC_UTF8}
|
||
- add LocalizeForm('TFormClassName') after {$I TFormClassName.lrs}
|
||
<CODE>
|
||
unit1;
|
||
[...]
|
||
initialization
|
||
{$I unit1.lrs}
|
||
LocalizeForm('TForm1');
|
||
end.
|
||
</CODE>
|
||
2. TIconv object example:
|
||
object is local variable here, but it can be global (create at startup,
|
||
dead in the end) if it's always in-use.
|
||
<CODE>
|
||
function koi8r_to_utf8(S:string):string;
|
||
var iConverter:pIconv;
|
||
begin
|
||
iConverter:=NewIconv('CP1251', 'UTF-8');
|
||
Result:=iConverter.iconv(S);
|
||
iConverter.Free;
|
||
end;
|
||
</CODE>
|
||
3. uiconv_xxx example - obvious.
|
||
|
||
APPENDIX
|
||
i. KNOWN DEVELOPER'S CODESET DEFENITIONS:
|
||
$DC_KOI8 (obvious)
|
||
$DC_UTF8 (obvious) - default
|
||
$DC_WIN (CP1251) - not tested yet
|
||
ii. GTK2 NOTES
|
||
As I found there's something wrong with some strings when gtk2 is used under
|
||
koi8-r locale. OpenDialog.FileName is stored in my inifile as koi8-r string
|
||
and then can't be loaded in MRU menu.
|
||
So I've got a couple of functions here for that case: str2gtk and gtk2str.
|
||
'str' means current codeset (locale)
|
||
iii. This unit tested with dc_utf8 and user's locale koi8-r only
|
||
*)
|
||
|
||
unit rxiconv;
|
||
(*
|
||
{* Developer's codeset. Must be set on design-time. Default is UTF8}
|
||
{.$DEFINE DC_KOI8}
|
||
{$DEFINE DC_WIN}
|
||
{.$DEFINE DC_UTF8} //nothing defined so DC_UTF8 will be defined here
|
||
{$IFNDEF DC_UTF8}
|
||
{$IFNDEF DC_KOI8}
|
||
{$IFNDEF DC_WIN}
|
||
{$DEFINE DC_UTF8}
|
||
{$ENDIF DC_WIN}
|
||
{$ENDIF DC_KOI8}
|
||
{$ENDIF DC_UTF8}
|
||
|
||
{* user acces to iconv functions}
|
||
{$DEFINE USER_ICONV}
|
||
{* TIconv object}
|
||
{$DEFINE USE_OBJECT}
|
||
{* Ticonv is class(TObject)}
|
||
{$DEFINE OBJ_IS_CLASS}
|
||
|
||
{* form-localization needed only with gtk1 or with gtk2 if developer's codeset
|
||
is not utf-8. First turn it of.}
|
||
{$UNDEF USE_LOCALIZE}
|
||
{* if widgetset is GTK2 ($IFDEF LCLGtk2) and developer's codeset is not DC_UTF8
|
||
then we'd FORCE_UTF8 and turn on USE_LOCALIZE. And if widgetset is GTK1 then
|
||
we USE_LOCALIZE too.}
|
||
{$IFDEF LCLGtk2}
|
||
{$IFNDEF DC_UTF8}
|
||
{$DEFINE USE_LOCALIZE}
|
||
{$DEFINE FORCE_UTF8}
|
||
{$ENDIF DC_UTF8}
|
||
{$ELSE LCLGtk2}
|
||
{$DEFINE USE_LOCALIZE}
|
||
{$ENDIF LCLGtk2}
|
||
|
||
{$mode objfpc}
|
||
*)
|
||
interface
|
||
(*
|
||
{$IFNDEF WINDOWS}
|
||
uses
|
||
{$IFDEF USE_LOCALIZE} LResources, Classes,{$ENDIF} initc, SysUtils;
|
||
|
||
{* returns current codeset}
|
||
function GetCodeset():ansistring;
|
||
{$IFDEF USE_LOCALIZE}
|
||
{* returns true if current codeset<>developer's codeset}
|
||
function InvalidCodeset():boolean;
|
||
{$ENDIF USE_LOCALIZE}
|
||
{* basic string conversion - enough for localization.
|
||
conversion from developer's codeset 2 user's codeset}
|
||
function Localize(source:ansistring):ansistring;
|
||
{with gtk2 converts utf8 to locale codeset and back}
|
||
{$IFDEF LCLGtk2}
|
||
function str2gtk(source:ansistring):ansistring;
|
||
function gtk2str(source:ansistring):ansistring;
|
||
{$ENDIF LCLGtk2}
|
||
{* public access 2 iconv}
|
||
{$IFDEF USER_ICONV}
|
||
function uiconv(ic_usr:pointer; source:ansistring):ansistring ;
|
||
function uiconv_open(ic_from, ic_to:ansistring):pointer ;
|
||
procedure uiconv_close(ic_usr:pointer) ;
|
||
{$ENDIF USER_ICONV}
|
||
{* form conversion}
|
||
procedure LocalizeForm(form_classname:ansistring);
|
||
procedure LocalizeAllForm;
|
||
|
||
{* iconv object/class}
|
||
{$IFDEF USE_OBJECT}
|
||
type
|
||
{$IFDEF OBJ_IS_CLASS}
|
||
Ticonv=class(TObject)
|
||
{$ELSE OBJ_IS_CLASS}
|
||
pIconv=^Ticonv;
|
||
Ticonv=object
|
||
protected
|
||
{$ENDIF OBJ_IS_CLASS}
|
||
hIconv:pointer;
|
||
public
|
||
destructor Destroy;{$IFDEF OBJ_IS_CLASS}virtual;{$ENDIF OBJ_IS_CLASS}
|
||
{$IFNDEF OBJ_IS_CLASS}
|
||
procedure Free;
|
||
{$ENDIF OBJ_IS_CLASS}
|
||
constructor Create{$IFDEF OBJ_IS_CLASS}(cs_from, cs_to:ansistring){$ENDIF OBJ_IS_CLASS};
|
||
function iconv(source:ansistring):ansistring;
|
||
end;
|
||
{$IFNDEF OBJ_IS_CLASS}
|
||
function NewIconv(cs_from, cs_to:ansistring):TIconv ;
|
||
{$ENDIF OBJ_IS_CLASS}
|
||
{$ENDIF USE_OBJECT}
|
||
{$ENDIF}
|
||
*)
|
||
implementation
|
||
(*
|
||
{$IFNDEF WINDOWS}
|
||
uses dialogs;
|
||
{$linklib c}
|
||
|
||
const
|
||
libiconvname='c';
|
||
__LC_CTYPE = 0;
|
||
_NL_CTYPE_CLASS = (__LC_CTYPE shl 16);
|
||
_NL_CTYPE_CODESET_NAME = (_NL_CTYPE_CLASS)+14;
|
||
CODESET = _NL_CTYPE_CODESET_NAME;
|
||
{developer's codeset names}
|
||
{$IFDEF DC_KOI8}
|
||
DEV_CODESET='KOI8-R';
|
||
DC_NAME='KOI';
|
||
DC_NAME_EXT='R';
|
||
{$ENDIF DC_KOI8}
|
||
{$IFDEF DC_UTF8}
|
||
DEV_CODESET='UTF-8';
|
||
DC_NAME='UTF';
|
||
DC_NAME_EXT='8';
|
||
{$ENDIF DC_UTF8}
|
||
{$IFDEF DC_WIN}
|
||
DEV_CODESET='CP1251';
|
||
DC_NAME='1251';
|
||
DC_NAME_EXT='1251';
|
||
{$ENDIF DC_WIN}
|
||
|
||
type
|
||
size_t = cardinal;
|
||
pSize = ^size_t;
|
||
psize_t = pSize;
|
||
cInt = longint;
|
||
piconv_t = ^iconv_t;
|
||
iconv_t = pointer;
|
||
nl_item = cint;
|
||
|
||
var //iconv pointers
|
||
{$IFDEF LCLGtk2}
|
||
ic_str2gtk, ic_gtk2str,
|
||
{$ENDIF LCLGtk2}
|
||
ic_localize : iconv_t;
|
||
|
||
function nl_langinfo(__item:nl_item):pchar;cdecl;external libiconvname name 'nl_langinfo';
|
||
function iconv_open(__tocode:pchar; __fromcode:pchar):iconv_t;cdecl;external libiconvname name 'iconv_open';
|
||
function iconv(__cd:iconv_t; __inbuf:ppchar; __inbytesleft:psize_t; __outbuf:ppchar; __outbytesleft:psize_t):size_t;cdecl;external libiconvname name 'iconv';
|
||
function iconv_close(__cd:iconv_t):cint;cdecl;external libiconvname name 'iconv_close';
|
||
|
||
{* common procedures}
|
||
function GetCodeset():ansistring;
|
||
begin
|
||
Result:= ansistring(nl_langinfo(CODESET));
|
||
end;
|
||
|
||
function CodesetIs(CSNAME, CSEXT:ansistring):boolean ;
|
||
var CS:ansistring;
|
||
begin
|
||
CS:=UpperCase(GetCodeSet);
|
||
if ((pos(CSNAME,CS)<>0) and (pos(CSEXT,CS)<>0)) then Result:=true else Result:=false;
|
||
end;
|
||
|
||
{* main conversion procedure}
|
||
function _iconv(hiconv:iconv_t; source:ansistring):ansistring;
|
||
const
|
||
ESysEILSEQ = 84;
|
||
ESysE2BIG = 7;
|
||
var
|
||
len:SizeInt;
|
||
outlength,
|
||
outoffset,
|
||
outleft : size_t;
|
||
srcpos,
|
||
destpos: pchar;
|
||
mynil : pchar;
|
||
my0 : size_t;
|
||
begin
|
||
mynil:=nil;
|
||
my0:=0;
|
||
// extra space
|
||
len:=length(source);
|
||
outlength:=len*3+1; //setlength(result,outlength);
|
||
Result:=StringOfChar(#0, outlength);
|
||
//outlength:=len+1;
|
||
srcpos:=pChar(source);
|
||
destpos:=pchar(result);
|
||
outleft:=outlength*2;
|
||
while iconv(hiconv,@srcpos,@len,@destpos,@outleft)=size_t(-1) do
|
||
begin
|
||
case fpgetCerrno of
|
||
ESysEILSEQ:
|
||
begin
|
||
{ skip and set to '?' }
|
||
inc(srcpos);
|
||
pwidechar(destpos)^:='?';
|
||
inc(destpos,2);
|
||
dec(outleft,2);
|
||
{ reset }
|
||
iconv(hiconv,@mynil,@my0,@mynil,@my0);
|
||
end;
|
||
ESysE2BIG:
|
||
begin
|
||
outoffset:=destpos-pchar(result);
|
||
{ extend }
|
||
setlength(result,outlength+len);
|
||
inc(outleft,len*2);
|
||
inc(outlength,len);
|
||
{ string could have been moved }
|
||
destpos:=pchar(result)+outoffset;
|
||
end;
|
||
else
|
||
raise EConvertError.Create('iconv error '+IntToStr(fpgetCerrno));
|
||
end;
|
||
end;
|
||
//setlength(result,length(result)-outleft div 2); // truncate string
|
||
Result:=TrimRight(Result);// not shure it always works right
|
||
end;
|
||
|
||
{$IFDEF USE_OBJECT}
|
||
{* Ticonv *}
|
||
{$IFNDEF OBJ_IS_CLASS}
|
||
function _NewIconv(cs_from, cs_to:ansistring):pIconv ;
|
||
begin
|
||
New( Result, Create);
|
||
Result^.hIconv:=Pointer(iconv_open(pChar(cs_to), pChar(cs_from)));
|
||
end;
|
||
|
||
function NewIconv(cs_from, cs_to:ansistring):TIconv ;
|
||
begin
|
||
Result:=_NewIconv(cs_from, cs_to)^;
|
||
end;
|
||
|
||
procedure Ticonv.Free();
|
||
begin
|
||
if @Self<>nil then Self.Destroy;
|
||
end;
|
||
{$ENDIF OBJ_IS_CLASS}
|
||
|
||
constructor Ticonv.Create{$IFDEF OBJ_IS_CLASS}(cs_from, cs_to:ansistring){$ENDIF OBJ_IS_CLASS};
|
||
begin {$IFDEF OBJ_IS_CLASS}
|
||
inherited Create;
|
||
hIconv:=Pointer(iconv_open(pChar(cs_to), pChar(cs_from)));
|
||
{$ENDIF OBJ_IS_CLASS}
|
||
end;
|
||
|
||
destructor Ticonv.Destroy;
|
||
begin
|
||
iconv_close(hIconv);
|
||
Inherited;
|
||
end;
|
||
|
||
function Ticonv.iconv(source:ansistring):ansistring;
|
||
begin
|
||
Result:=_iconv(hIconv, source);
|
||
end;
|
||
{$ENDIF USE_OBJECT}
|
||
|
||
{$IFDEF USER_ICONV}
|
||
function uiconv(ic_usr:pointer; source:ansistring):ansistring ;
|
||
begin
|
||
Result:=_iconv(iconv_t(ic_usr), pchar(source));
|
||
end;
|
||
|
||
function uiconv_open(ic_from, ic_to:ansistring):pointer ;
|
||
begin
|
||
Result:= iconv_open(pchar(ic_to), pchar(ic_from));
|
||
end;
|
||
|
||
procedure uiconv_close(ic_usr:pointer) ;
|
||
begin
|
||
iconv_close(iconv_t(ic_usr));
|
||
end;
|
||
{$ENDIF USER_ICONV}
|
||
|
||
function Localize(source:ansistring):ansistring;
|
||
begin
|
||
Result:=_iconv(ic_localize, source);
|
||
end;
|
||
|
||
{$IFDEF LCLGtk2}
|
||
function str2gtk(source:ansistring):ansistring;
|
||
begin
|
||
Result:=_iconv(ic_str2gtk, source);
|
||
end;
|
||
|
||
function gtk2str(source:ansistring):ansistring;
|
||
begin
|
||
Result:=_iconv(ic_gtk2str, source);
|
||
end;
|
||
{$ENDIF LCLGtk2}
|
||
|
||
{* form localization - only if use_localize}
|
||
{$IFDEF USE_LOCALIZE}
|
||
function InvalidCodeset():boolean;
|
||
begin
|
||
Result:=False;
|
||
{$IFNDEF FORCE_UTF8} Result:= not (CodesetIs(DC_NAME, DC_NAME_EXT));{$ENDIF FORCE_UTF8}
|
||
end;
|
||
|
||
{* converts form resource from developer's codeset to env codeset.
|
||
it's empty procedure if widgetSet is gtk2 and dev's codeset is utf8.
|
||
So USE_LOCCALIZE definition used }
|
||
procedure LocalizeForm(form_classname:ansistring);
|
||
var res : TLResource;
|
||
S : ansistring;
|
||
RS, MS : TMemoryStream;
|
||
begin
|
||
{$IFNDEF FORCE_UTF8} //always convert to utf8
|
||
if not InvalidCodeset then exit;
|
||
{$ENDIF FORCE_UTF8}
|
||
{find resource}
|
||
res:=LazarusResources.Find(form_classname);
|
||
RS:=TMemoryStream.create;
|
||
MS:=TMemoryStream.create;
|
||
{read form 2 RS}
|
||
RS.Write(res.Value[1],length(res.Value));
|
||
RS.Position:=0;
|
||
{convert 2 text}
|
||
LRSObjectBinaryToText( RS, MS);
|
||
MS.Position:=0;
|
||
{copy 2 string}
|
||
SetLength(S, MS.Size);
|
||
MS.Read(S[1], MS.Size);
|
||
{convert 2 ccs or utf8 - under gtk2}
|
||
S:=Localize(S);
|
||
{copy back to ms}
|
||
S:=Trim(S) + #0#0#0#0; //doesn't work without it...
|
||
MS.Position:=0;
|
||
MS.Write(S[1],length(S));
|
||
MS.Position:=0;
|
||
RS.SetSize(0);
|
||
{convert 2 binary RS}
|
||
LRSObjectTextToBinary(MS, RS);
|
||
RS.Position:=0;
|
||
SetLength(S, RS.Size);
|
||
{write 2 resource}
|
||
RS.Read(S[1],RS.Size);
|
||
res.Value:=S;
|
||
MS.Free; RS.Free;
|
||
end;
|
||
|
||
procedure LocalizeAllForm;
|
||
var
|
||
i:integer;
|
||
begin
|
||
for i:=0 to LazarusResources.Count - 1 do
|
||
begin
|
||
if LazarusResources.Items[i].ValueType = 'FORMDATA' then
|
||
LocalizeForm(LazarusResources.Items[i].Name);
|
||
end;
|
||
end;
|
||
|
||
{$ELSE USE_LOCALIZE}
|
||
{* dummy proc for easy testing}
|
||
procedure LocalizeForm(form_classname:ansistring);begin {*} end;
|
||
|
||
procedure LocalizeAllForm;
|
||
begin
|
||
end;
|
||
|
||
{$ENDIF USE_LOCALIZE}
|
||
|
||
initialization
|
||
{$IFNDEF FORCE_UTF8}
|
||
ic_localize := iconv_open(nl_langinfo(CODESET), DEV_CODESET); //main
|
||
{$ELSE FORCE_UTF8}
|
||
ic_localize := iconv_open('UTF-8', DEV_CODESET);
|
||
{$ENDIF FORCE_UTF8}
|
||
{$IFDEF LCLGtk2}
|
||
ic_str2gtk:= iconv_open('UTF-8', nl_langinfo(CODESET));
|
||
ic_gtk2str:= iconv_open(nl_langinfo(CODESET), 'UTF-8');
|
||
{$ENDIF LCLGtk2}
|
||
finalization
|
||
iconv_close(ic_localize);
|
||
{$IFDEF LCLGtk2}
|
||
iconv_close(ic_str2gtk);
|
||
iconv_close(ic_gtk2str);
|
||
{$ENDIF LCLGtk2}
|
||
{$ENDIF}
|
||
*)
|
||
end.
|