paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 16:29:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

rtl: apply piece of changes to charset.pp from Inoussa (part of mantis #0022909)

Browse Source 
git-svn-id: trunk@23658 -
This commit is contained in:
paul 2013-02-25 02:22:14 +00:00
parent e549954de6
commit 535615dfa4
1 changed files with 125 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
rtl/inc/charset.pp
View File

@ -56,10 +56,20 @@ unit charset;
function mappingavailable(const s : string) : boolean; function mappingavailable(const s : string) : boolean;
function mappingavailable(cp :word) : boolean; function mappingavailable(cp :word) : boolean;
function getunicode(c : char;p : punicodemap) : tunicodechar; function getunicode(c : char;p : punicodemap) : tunicodechar;
function getunicode(
AAnsiStr : pansichar;
AAnsiLen : SizeInt;
AMap : punicodemap;
ADest : tunicodestring
) : SizeInt;
function getascii(c : tunicodechar;p : punicodemap) : string; function getascii(c : tunicodechar;p : punicodemap) : string;
function getascii(c : tunicodechar;p : punicodemap; ABuffer : PAnsiChar; ABufferLen : SizeInt) : SizeInt;
implementation implementation
const
UNKNOW_CHAR_A = ansichar(63);
UNKNOW_CHAR_W = tunicodechar(63);
var var
mappings : punicodemap; mappings : punicodemap;
@ -253,6 +263,75 @@ unit charset;
getunicode:=0; getunicode:=0;
end; end;
function getunicode(
AAnsiStr : pansichar;
AAnsiLen : SizeInt;
AMap : punicodemap;
ADest : tunicodestring
) : SizeInt;
var
i, c, k, destLen : longint;
ps : pansichar;
pd : ^tunicodechar;
begin
if (AAnsiStr=nil) or (AAnsiLen<=0) then
exit(0);
ps:=AAnsiStr;
if (ADest=nil) then
begin
c:=AAnsiLen-1;
destLen:=0;
i:=0;
while (i<=c) do
begin
if (ord(ps^)<=AMap^.lastchar) then
begin
if (AMap^.map[ord(ps^)].flag=umf_leadbyte) and (i<c) then
Inc(ps);
end;
i:=i+1;
Inc(ps);
destLen:=destLen+1;
end;
exit(destLen);
end;
pd:=ADest;
c:=AAnsiLen-1;
i:=0;
while (i<=c) do
begin
if (ord(ps^)<=AMap^.lastchar) then
begin
if (AMap^.map[ord(ps^)].flag=umf_leadbyte) then
begin
if (i<c) then
begin
k:=(Ord(ps^)*256);
Inc(ps);
k:=k+Ord(ps^);
if (k<=AMap^.lastchar) then
pd^:=AMap^.map[k].unicode
else
pd^:=UNKNOW_CHAR_W;
end
else
pd^:=UNKNOW_CHAR_W;
end
else
pd^:=AMap^.map[ord(ps^)].unicode
end
else
pd^:=UNKNOW_CHAR_W;
i:=i+1;
Inc(ps);
Inc(pd);
end;
result:=((PtrUInt(pd)-PtrUInt(ADest)) div SizeOf(tunicodechar));
end;
function getascii(c : tunicodechar;p : punicodemap) : string; function getascii(c : tunicodechar;p : punicodemap) : string;
var var
@ -272,6 +351,52 @@ unit charset;
end; end;
end; end;
function getascii(c : tunicodechar;p : punicodemap; ABuffer : PAnsiChar; ABufferLen : SizeInt) : SizeInt;
var
i : longint;
begin
if (ABuffer<>nil) and (ABufferLen<=0) then
begin
Result:=-1;
exit;
end;
for i:=0 to p^.lastchar do
if p^.map[i].unicode=c then
begin
if (ABuffer=nil) then
begin
if i<256 then
Result:=1
else
Result:=2;
exit;
end;
if i<256 then
begin
Result:=1;
ABuffer^:=chr(i);
end
else
begin
if (ABufferLen<2) then
begin
Result:=-1;
exit;
end;
ABuffer^:=chr(i div 256);
Inc(ABuffer);
ABuffer^:=chr(i mod 256);
end;
exit;
end;
{ at least map to '?' }
Result := 1;
if (ABuffer<>nil) then
ABuffer^:=#63;
end;
var var
hp : punicodemap; hp : punicodemap;