mirror of
https://github.com/keymanapp/keyman.git
synced 2026-08-06 08:55:34 +00:00
421 lines
9.6 KiB
ObjectPascal
421 lines
9.6 KiB
ObjectPascal
(*
|
|
Name: utilstr
|
|
Copyright: Copyright (C) SIL International.
|
|
Documentation:
|
|
Description:
|
|
Create Date: 1 Aug 2006
|
|
|
|
Modified Date: 8 Jun 2012
|
|
Authors: mcdurdin
|
|
Related Files:
|
|
Dependencies:
|
|
|
|
Bugs:
|
|
Todo:
|
|
Notes:
|
|
History: 01 Aug 2006 - mcdurdin - Refactor util functions into multiple units
|
|
23 Aug 2006 - mcdurdin - Add StringToExtString and WideQuotedStr functions
|
|
14 Sep 2006 - mcdurdin - Add RectToString, StringToRect, use widestrings for some functions
|
|
16 May 2007 - mcdurdin - Fix CommaToken to widestring
|
|
12 Mar 2010 - mcdurdin - I891 - Search for U+22 as well as U+0022
|
|
25 Mar 2011 - mcdurdin - I2705 - Inserting supplementary plane characters into Layout tab generates surrogate pairs
|
|
04 May 2012 - mcdurdin - I3306 - V9.0 - Remove TntControls + Win9x support
|
|
*)
|
|
unit utilstr; // I3306
|
|
|
|
interface
|
|
|
|
uses
|
|
System.Classes,
|
|
System.Types,
|
|
System.WideStrings;
|
|
|
|
const
|
|
CRLF = #13#10;
|
|
|
|
function RectToString(r: TRect): string;
|
|
function StringToRect(s: string): TRect;
|
|
|
|
function wchr(n: Integer): WideChar;
|
|
function StrToken(var s: string; const tokens: string): string;
|
|
function WStrToken(var s: WideString; const tokens: WideString): WideString; deprecated; // I3310
|
|
function CommaToken(var s: WideString): WideString;
|
|
|
|
procedure TagsToStringList(s: WideString; str: TWideStrings);
|
|
procedure SplitString(const instr: string; var outstr1, outstr2: string; const split: string);
|
|
function FormatUnicode(s: WideString): string;
|
|
function FormatANSI(s: string): string;
|
|
|
|
function ExtNumToInt(s: string): Integer;
|
|
function IntToExtNum(n, base: Integer): string;
|
|
|
|
function ExtStringToString(s: string; out FError: Boolean): string; // I3310
|
|
function StringToExtString(const s: string; FormatUnicode: Boolean): string; // I3310
|
|
|
|
function TrimQuotes(s: string): string;
|
|
|
|
function GetTokenFromCaret(line: string; var selx, sellen: Integer): string;
|
|
|
|
function WideQuotedStr(const str: WideString): WideString; deprecated; // I3310
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.SysUtils,
|
|
|
|
Unicode;
|
|
|
|
function CommaToken(var s: WideString): WideString;
|
|
var
|
|
n: Integer;
|
|
begin
|
|
while (s <> '') and (Pos(s[1], ' '#9#13#10) > 0) do Delete(s,1,1);
|
|
|
|
if s = '' then
|
|
begin
|
|
Result := '';
|
|
Exit;
|
|
end;
|
|
|
|
if s[1] = '"' then
|
|
begin
|
|
Delete(s,1,1);
|
|
n := Pos('"', s);
|
|
if n = 0 then raise Exception.Create('CommaToken: Unmatched opening quote in input text');
|
|
Result := Trim(Copy(s, 1, n-1));
|
|
Delete(s, 1, n);
|
|
if s <> '' then
|
|
if s[1] <> ','
|
|
then raise Exception.Create('CommaToken: Expected but did not find comma or EOL after closing quote')
|
|
else Delete(s,1,1);
|
|
end
|
|
else
|
|
begin
|
|
n := Pos(',', s);
|
|
if n = 0 then n := Length(s)+1;
|
|
Result := Trim(Copy(s, 1, n-1));
|
|
Delete(s, 1, n);
|
|
end;
|
|
|
|
while (s <> '') and (Pos(s[1], ' '#9#13#10) > 0) do Delete(s,1,1);
|
|
end;
|
|
|
|
procedure TagsToStringList(s: WideString; str: TWideStrings);
|
|
var
|
|
n: Integer;
|
|
t: WideString;
|
|
begin
|
|
s := Trim(s);
|
|
while s <> '' do
|
|
begin
|
|
if s[1] <> '<' then Exit;
|
|
Delete(s,1,1);
|
|
n := Pos('>', s);
|
|
if n = 0 then Exit;
|
|
t := Copy(s, 1, n-1);
|
|
Delete(s,1,n);
|
|
n := Pos('</'+t+'>', s);
|
|
if n = 0 then Exit;
|
|
str.Add(t + '=' + Copy(s, 1, n-1));
|
|
Delete(s, 1, n+Length(t)+2);
|
|
s := Trim(s);
|
|
end;
|
|
end;
|
|
|
|
procedure SplitString(const instr: string; var outstr1, outstr2: string; const split: string);
|
|
var
|
|
n: Integer;
|
|
begin
|
|
n := Pos(split, instr);
|
|
if n > 0 then
|
|
begin
|
|
outstr1 := Copy(instr,1,n-1);
|
|
outstr2 := Copy(instr,n+1,Length(instr));
|
|
end
|
|
else
|
|
begin
|
|
outstr1 := instr;
|
|
outstr2 := instr;
|
|
end;
|
|
end;
|
|
|
|
function FormatANSI(s: string): string;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
for i := 1 to Length(s) do
|
|
Result := Result + Format('d%d ', [Ord(s[i])]);
|
|
Result := Trim(Result);
|
|
end;
|
|
|
|
function FormatUnicode(s: WideString): string;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
i := 1;
|
|
while i <= Length(s) do
|
|
begin
|
|
if Uni_IsSurrogate1(s[i]) and (i < Length(s)) then
|
|
begin
|
|
Result := Result + Format('U+%4.4X ', [Uni_SurrogateToUTF32(s[i], s[i+1])]);
|
|
Inc(i);
|
|
end
|
|
else
|
|
Result := Result + Format('U+%4.4X ', [Ord(s[i])]);
|
|
Inc(i);
|
|
end;
|
|
Result := Trim(Result);
|
|
end;
|
|
|
|
function ExtNumToInt(s: string): Integer;
|
|
begin
|
|
Result := 0;
|
|
s := LowerCase(Trim(s));
|
|
if (s <> '') then
|
|
begin
|
|
if s[1] = 'x' then
|
|
Result := StrToIntDef('$' + Copy(s,2,32), 0)
|
|
else if s[1] = 'd' then
|
|
Result := StrToIntDef(Copy(s,2,32), 0)
|
|
else if Copy(s,1,2) = 'u+' then
|
|
begin
|
|
if Length(s) < 4 then Exit; // I891 - we want U+E01 to find U+0E01 for simplicity
|
|
Result := StrToIntDef('$' + Copy(s,3,32), 0);
|
|
end
|
|
else if CharInSet(s[1], ['0'..'9']) then
|
|
Result := StrToIntDef(s, 0);
|
|
end;
|
|
end;
|
|
|
|
function IntToExtNum(n, base: Integer): string;
|
|
begin
|
|
if base = 16 then
|
|
Result := 'x' + IntToHex(n, 1)
|
|
else
|
|
Result := 'd' + IntToStr(n);
|
|
end;
|
|
|
|
function TrimQuotes(s: string): string;
|
|
begin
|
|
s := Trim(s);
|
|
|
|
if Length(s) < 2 then
|
|
begin
|
|
Result := s;
|
|
Exit;
|
|
end;
|
|
|
|
if CharInSet(s[1], ['"', '''']) and (s[Length(s)] = s[1]) then
|
|
begin
|
|
Delete(s, 1, 1);
|
|
Delete(s, Length(s), 1);
|
|
end;
|
|
|
|
Result := s;
|
|
end;
|
|
|
|
function isspace(s: Char): Boolean;
|
|
begin
|
|
Result := CharInSet(s, [' ', #9, #13, #10]);
|
|
end;
|
|
|
|
function GetTokenFromCaret(line: string; var selx, sellen: Integer): string;
|
|
begin
|
|
Result := '';
|
|
if selx > Length(line)+1 then Exit;
|
|
Dec(selx);
|
|
while selx >= 1 do
|
|
begin
|
|
if isspace(line[selx]) then Break;
|
|
Dec(selx);
|
|
end;
|
|
if selx > 0 then Delete(line, 1, selx);
|
|
sellen := 0;
|
|
while (sellen < Length(line)) and not isspace(line[sellen+1]) do
|
|
Inc(sellen);
|
|
Delete(line, sellen+1, Length(line));
|
|
Result := line;
|
|
end;
|
|
|
|
function StrToken(var s: string; const tokens: string): string;
|
|
var
|
|
n: Integer;
|
|
begin
|
|
Result := '';
|
|
|
|
if s = '' then Exit;
|
|
|
|
while (s <> '') and (Pos(s[1], tokens) > 0) do
|
|
begin
|
|
Delete(s, 1, 1);
|
|
end;
|
|
|
|
if s = '' then Exit;
|
|
|
|
n := 1;
|
|
while (n <= Length(s)) and (Pos(s[n], tokens) = 0) do
|
|
begin
|
|
Inc(n);
|
|
end;
|
|
|
|
Result := Copy(s, 1, n-1);
|
|
Delete(s, 1, n);
|
|
end;
|
|
|
|
function WStrToken(var s: WideString; const tokens: WideString): WideString;
|
|
var
|
|
n: Integer;
|
|
begin
|
|
Result := '';
|
|
|
|
if s = '' then Exit;
|
|
|
|
while (s <> '') and (Pos(s[1], tokens) > 0) do
|
|
begin
|
|
Delete(s, 1, 1);
|
|
end;
|
|
|
|
if s = '' then Exit;
|
|
|
|
n := 1;
|
|
while (n <= Length(s)) and (Pos(s[n], tokens) = 0) do
|
|
begin
|
|
Inc(n);
|
|
end;
|
|
|
|
Result := Copy(s, 1, n-1);
|
|
s := Copy(s, n+1, Length(s));
|
|
end;
|
|
|
|
function wchr(n: Integer): WideChar;
|
|
begin
|
|
Result := WideChar(n);
|
|
end;
|
|
|
|
function StringToExtString(const s: string; FormatUnicode: Boolean): string; // I3310
|
|
var
|
|
n, v: Integer;
|
|
begin
|
|
Result := '';
|
|
n := 1;
|
|
while n <= Length(s) do
|
|
begin
|
|
v := Ord(s[n]);
|
|
if FormatUnicode then
|
|
begin
|
|
if (n < Length(s)) and Uni_IsSurrogate1(s[n]) and Uni_IsSurrogate2(s[n+1]) then
|
|
begin
|
|
v := Uni_SurrogateToUTF32(s[n], s[n+1]);
|
|
Inc(n);
|
|
end;
|
|
Result := Result + 'U+'+IntToHex(v, 4)+' ';
|
|
end
|
|
else
|
|
Result := Result + 'd'+IntToStr(v)+' ';
|
|
Inc(n);
|
|
end;
|
|
Result := Trim(Result);
|
|
end;
|
|
|
|
|
|
function ExtStringToString(s: string; out FError: Boolean): string; // I3310
|
|
var
|
|
t: string;
|
|
opch: string;
|
|
n: Integer;
|
|
begin
|
|
Result := '';
|
|
t := '';
|
|
FError := True;
|
|
while s <> '' do
|
|
begin
|
|
case s[1] of
|
|
' ', #9, #13, #10: Delete(s,1,1);
|
|
'U', 'u':
|
|
begin
|
|
if Length(s) < 2 then Exit;
|
|
if s[2] <> '+' then Exit;
|
|
Delete(s,1,2);
|
|
opch := '$' + StrToken(s, ' '#9#13#10); // I3310
|
|
if not (Length(opch) in [5, 6, 7]) then Exit;
|
|
n := StrToIntDef(opch, 0);
|
|
if (n < 32) or (n > $10FFFF) then Exit;
|
|
t := t + Uni_UTF32CharToUTF16(n); // I2705
|
|
end;
|
|
'd':
|
|
begin
|
|
Delete(s,1,1);
|
|
n := StrToIntDef(StrToken(s, ' '#9#13#10), 0); // I3310
|
|
if (n < 32) or (n > $10FFFF) then Exit;
|
|
t := t + Uni_UTF32CharToUTF16(n); // I2705
|
|
end;
|
|
'x':
|
|
begin
|
|
Delete(s,1,1);
|
|
n := StrToIntDef('$' + StrToken(s, ' '#9#13#10), 0); // I3310
|
|
if (n < 32) or (n > $10FFFF) then Exit;
|
|
t := t + Uni_UTF32CharToUTF16(n); // I2705
|
|
end;
|
|
'0'..'7':
|
|
begin
|
|
n := StrToIntDef(StrToken(s, ' '#9#13#10), 0); // I3310
|
|
if (n < 40) or (n > 4177777) then Exit;
|
|
t := t + Uni_UTF32CharToUTF16(n); // I2705
|
|
end;
|
|
'''', '"':
|
|
begin
|
|
opch := s[1];
|
|
Delete(s,1,1);
|
|
while (s <> '') and (s[1] <> opch) do
|
|
begin
|
|
t := t + s[1]; Delete(s, 1, 1);
|
|
end;
|
|
if s = '' then Exit;
|
|
Delete(s, 1, 1);
|
|
end;
|
|
else
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
FError := False;
|
|
Result := t;
|
|
end;
|
|
|
|
function WideQuotedStr(const str: WideString): WideString;
|
|
begin
|
|
Result := StringReplace(str, '''', '''''', [rfReplaceAll])
|
|
end;
|
|
|
|
function RectToString(r: TRect): string;
|
|
begin
|
|
Result := Format('%d,%d,%d,%d', [r.Left, r.Top, r.Right, r.Bottom]);
|
|
end;
|
|
|
|
function StringToRect(s: string): TRect;
|
|
var
|
|
n: Integer;
|
|
begin
|
|
n := Pos(',', s);
|
|
if n = 0 then Exit;
|
|
Result.Left := StrToIntDef(Copy(s,1,n-1), 0);
|
|
Delete(s,1,n);
|
|
|
|
n := Pos(',', s);
|
|
if n = 0 then Exit;
|
|
Result.Top := StrToIntDef(Copy(s,1,n-1), 0);
|
|
Delete(s,1,n);
|
|
|
|
n := Pos(',', s);
|
|
if n = 0 then Exit;
|
|
Result.Right := StrToIntDef(Copy(s,1,n-1), 0);
|
|
Delete(s,1,n);
|
|
|
|
Result.Bottom := StrToIntDef(s, 0);
|
|
end;
|
|
|
|
end.
|