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

+ unicode functions for sysutils, makes tunistr6.pp compiling

Browse Source 
git-svn-id: trunk@13402 -
This commit is contained in:
florian 2009-07-17 14:05:19 +00:00
parent e8088fd4ec
commit 5d8835861c
7 changed files with 206 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -6249,6 +6249,8 @@ rtl/objpas/sysutils/sysstr.inc svneol=native#text/plain
rtl/objpas/sysutils/sysstrh.inc svneol=native#text/plain
rtl/objpas/sysutils/systhrdh.inc svneol=native#text/plain
rtl/objpas/sysutils/sysuintf.inc svneol=native#text/plain
rtl/objpas/sysutils/sysuni.inc svneol=native#text/plain
rtl/objpas/sysutils/sysunih.inc svneol=native#text/plain
rtl/objpas/sysutils/sysuthrd.inc svneol=native#text/plain
rtl/objpas/sysutils/sysutilh.inc svneol=native#text/plain
rtl/objpas/sysutils/sysutils.inc svneol=native#text/plain

2
rtl/fpmake.inc
View File

@ -160,6 +160,7 @@ begin
Add(SysUtilsDir+'syspchh.inc');
Add(SysUtilsDir+'systhrdh.inc');
Add(SysUtilsDir+'syswideh.inc');
Add(SysUtilsDir+'sysunih.inc');
Add(SysUtilsDir+'dati.inc');
Add(SysUtilsDir+'fina.inc');
Add(SysUtilsDir+'stre.inc');
@ -167,6 +168,7 @@ begin
Add(SysUtilsDir+'syspch.inc');
Add(SysUtilsDir+'sysuintf.inc');
Add(SysUtilsDir+'syswide.inc');
Add(SysUtilsDir+'sysuni.inc');
Add(SysUtilsDir+'diskh.inc');
Add(SysUtilsDir+'intfh.inc');
Add(SysUtilsDir+'strg.inc');

2
rtl/fpmake.pp
View File

@ -439,6 +439,7 @@ begin
AddInclude('syspchh.inc');
AddInclude('sysansih.inc');
AddInclude('syswideh.inc');
AddInclude('sysunih.inc');
AddInclude('finah.inc');
AddInclude('filutilh.inc');
AddInclude('diskh.inc');
@ -458,6 +459,7 @@ begin
AddInclude('sysint.inc');
AddInclude('sysansi.inc');
AddInclude('syswide.inc');
AddInclude('sysuni.inc');
AddInclude('sysformt.inc');
AddInclude('sysuthrd.inc');
AddInclude('osutil.inc');

153
rtl/objpas/sysutils/sysuni.inc Normal file
View File

@ -0,0 +1,153 @@
{
*********************************************************************
Copyright (C) 2002-2005 by Florian Klaempfl
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
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. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*********************************************************************
}
function Trim(const S: unicodestring): unicodestring;
var
Ofs, Len: sizeint;
begin
len := Length(S);
while (Len>0) and (S[Len]<=' ') do
dec(Len);
Ofs := 1;
while (Ofs<=Len) and (S[Ofs]<=' ') do
Inc(Ofs);
result := Copy(S, Ofs, 1 + Len - Ofs);
end;
{ TrimLeft returns a copy of S with all blank characters on the left stripped off }
function TrimLeft(const S: unicodestring): unicodestring;
var
i,l:sizeint;
begin
l := length(s);
i := 1;
while (i<=l) and (s[i]<=' ') do
inc(i);
Result := copy(s, i, l);
end;
{ TrimRight returns a copy of S with all blank characters on the right stripped off }
function TrimRight(const S: unicodestring): unicodestring;
var
l:sizeint;
begin
l := length(s);
while (l>0) and (s[l]<=' ') do
dec(l);
result := copy(s,1,l);
end;
function UnicodeUpperCase(const s : UnicodeString) : UnicodeString;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
result:=widestringmanager.UpperUnicodeStringProc(s);
end;
function UnicodeLowerCase(const s : UnicodeString) : UnicodeString;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
result:=widestringmanager.LowerUnicodeStringProc(s);
end;
function UnicodeCompareStr(const s1, s2 : UnicodeString) : PtrInt;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
result:=widestringmanager.CompareUnicodeStringProc(s1,s2);
end;
function UnicodeSameStr(const s1, s2 : UnicodeString) : Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
result:=widestringmanager.CompareUnicodeStringProc(s1,s2)=0;
end;
function UnicodeCompareText(const s1, s2 : UnicodeString) : PtrInt;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
result:=widestringmanager.CompareTextUnicodeStringProc(s1,s2);
end;
function UnicodeSameText(const s1, s2 : UnicodeString) : Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
result:=widestringmanager.CompareTextUnicodeStringProc(s1,s2)=0;
end;
{ we've no templates, but with includes we can simulate this :) }
{$macro on}
{$define INWIDEFORMAT}
{$define TFormatString:=unicodestring}
{$define TFormatChar:=unicodechar}
Function UnicodeFormat (Const Fmt : UnicodeString; const Args : Array of const; Const FormatSettings: TFormatSettings) : UnicodeString;
{$i sysformt.inc}
{$undef TFormatString}
{$undef TFormatChar}
{$undef INWIDEFORMAT}
{$macro off}
Function UnicodeFormat (Const Fmt : UnicodeString; const Args : Array of const) : UnicodeString;
begin
Result:=UnicodeFormat(Fmt,Args,DefaultFormatSettings);
end;
Function UnicodeFormatBuf (Var Buffer; BufLen : Cardinal;
Const Fmt; fmtLen : Cardinal;
Const Args : Array of const; Const FormatSettings: TFormatSettings) : Cardinal;
Var
S,F : UnicodeString;
begin
Setlength(F,fmtlen);
if fmtlen > 0 then
Move(fmt,F[1],fmtlen*sizeof(Unicodechar));
S:=UnicodeFormat (F,Args);
If Cardinal(Length(S))<Buflen then
Result:=Length(S)
else
Result:=Buflen;
Move(S[1],Buffer,Result);
end;
Function UnicodeFormatBuf (Var Buffer; BufLen : Cardinal;
Const Fmt; fmtLen : Cardinal;
Const Args : Array of const) : Cardinal;
begin
Result:=UnicodeFormatBuf(Buffer,BufLEn,Fmt,FmtLen,Args,DefaultFormatSettings);
end;
Procedure UnicodeFmtStr(Var Res: UnicodeString; Const Fmt : UnicodeString; Const args: Array of const; Const FormatSettings: TFormatSettings);
begin
Res:=UnicodeFormat(fmt,Args);
end;
Procedure UnicodeFmtStr(Var Res: UnicodeString; Const Fmt : UnicodeString; Const args: Array of const);
begin
UnicodeFmtStr(Res,Fmt,Args,DefaultFormatSettings);
end;

37
rtl/objpas/sysutils/sysunih.inc Normal file
View File

@ -0,0 +1,37 @@
{
*********************************************************************
Copyright (C) 2002 by Florian Klaempfl
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
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. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*********************************************************************
}
function Trim(const S: unicodestring): unicodestring;
function TrimLeft(const S: unicodestring): unicodestring;
function TrimRight(const S: unicodestring): unicodestring;
function UnicodeUpperCase(const s : UnicodeString) : UnicodeString;{$ifdef SYSUTILSINLINE}inline;{$endif}
function UnicodeLowerCase(const s : UnicodeString) : UnicodeString;{$ifdef SYSUTILSINLINE}inline;{$endif}
function UnicodeCompareStr(const s1, s2 : UnicodeString) : PtrInt;{$ifdef SYSUTILSINLINE}inline;{$endif}
function UnicodeSameStr(const s1, s2 : UnicodeString) : Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
function UnicodeCompareText(const s1, s2 : UnicodeString) : PtrInt;{$ifdef SYSUTILSINLINE}inline;{$endif}
function UnicodeSameText(const s1, s2 : UnicodeString) : Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
Function UnicodeFormat (Const Fmt : UnicodeString; const Args : Array of const) : UnicodeString;
Function UnicodeFormat (Const Fmt : UnicodeString; const Args : Array of const; Const FormatSettings: TFormatSettings) : UnicodeString;
Function UnicodeFormatBuf (Var Buffer; BufLen : Cardinal; Const Fmt; fmtLen : Cardinal; Const Args : Array of const) : Cardinal;
Function UnicodeFormatBuf (Var Buffer; BufLen : Cardinal; Const Fmt; fmtLen : Cardinal; Const Args : Array of const; Const FormatSettings: TFormatSettings) : Cardinal;
Procedure UnicodeFmtStr(Var Res: UnicodeString; Const Fmt : UnicodeString; Const args: Array of const);
Procedure UnicodeFmtStr(Var Res: UnicodeString; Const Fmt : UnicodeString; Const args: Array of const; Const FormatSettings: TFormatSettings);

5
rtl/objpas/sysutils/sysutilh.inc
View File

@ -222,6 +222,11 @@ Type
{ wide string functions }
{$i syswideh.inc}
{$ifdef FPC_HAS_UNICODESTRING}
{ unicode string functions }
{$i sysunih.inc}
{$endif FPC_HAS_UNICODESTRING}
{ Read filename handling functions declaration }
{$i finah.inc}

5
rtl/objpas/sysutils/sysutils.inc
View File

@ -108,6 +108,11 @@
{ wide string functions }
{$i syswide.inc}
{$ifdef FPC_HAS_UNICODESTRING}
{ unicode string functions }
{$i sysuni.inc}
{$endif FPC_HAS_UNICODESTRING}
{ threading stuff }
{$i sysuthrd.inc}