summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/corelib/gfx_strings.pas1024
-rw-r--r--src/corelib/gfx_utf8utils.pas4
-rw-r--r--src/corelib/x11/fpgfx_package.lpk8
-rw-r--r--src/corelib/x11/fpgfx_package.pas2
4 files changed, 1033 insertions, 5 deletions
diff --git a/src/corelib/gfx_strings.pas b/src/corelib/gfx_strings.pas
new file mode 100644
index 00000000..fe49fb40
--- /dev/null
+++ b/src/corelib/gfx_strings.pas
@@ -0,0 +1,1024 @@
+{
+ fpGUI - Free Pascal GUI Library
+
+ Unit to handle WideString (UTF-16) strings.
+
+ Copyright (C) 2007 See the file AUTHORS.txt, included in this
+ distribution, for details of the copyright.
+
+ See the file COPYING.modifiedLGPL, included in this distribution,
+ for details about redistributing fpGUI.
+
+ 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.
+}
+
+
+ // ******* PLEASE DO NOT USE THIS UNIT!!!! *******
+
+
+ // Graeme: I'm experimenting with something again.
+
+
+unit gfx_strings;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes,
+ SysUtils;
+
+type
+ // forward declarations
+ TWideStrings = class;
+ TWideStringList = class;
+
+ // independant types that could be used in fpGUI
+ gfxString = WideString; // string
+ gfxChar = WideChar; // char
+ gfxPChar = PWideChar; // pchar
+ gfxStringList = TWideStringList; // TStringList
+
+
+{$Warnings off} // because I'm hiding the TStrings String properties
+
+ { A WideString version of the abstract TStrings class. }
+ TWideStrings = class(TStrings)
+ private
+ FUpdateCount: integer;
+ function GetCommaText: WideString;
+ function GetName(Index: integer): WideString;
+ function GetValue(const Name: WideString): WideString;
+ procedure ReadData(Reader: TReader);
+ procedure SetCommaText(const Value: WideString);
+ procedure SetValue(const Name, Value: WideString);
+ procedure WriteData(Writer: TWriter);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ procedure Error(const Msg: string; Data: integer);
+ function Get(Index: integer): WideString; virtual; abstract;
+ function GetCapacity: integer; virtual;
+ function GetCount: integer; virtual; abstract;
+ function GetObject(Index: integer): TObject; virtual;
+ function GetTextStr: WideString; virtual;
+ procedure Put(Index: integer; const S: WideString); virtual;
+ procedure PutObject(Index: integer; AObject: TObject); virtual;
+ procedure SetCapacity(NewCapacity: integer); virtual;
+ procedure SetTextStr(const Value: WideString); virtual;
+ procedure SetUpdateState(Updating: Boolean); virtual;
+ public
+ constructor Create;
+ function Add(const S: WideString): integer; virtual;
+ function AddObject(const S: WideString; AObject: TObject): integer; virtual;
+ procedure Append(const S: WideString);
+ procedure AddStrings(aStrings: TWideStrings); virtual;
+ procedure Assign(Source: TPersistent); override;
+ procedure BeginUpdate;
+ procedure Clear; virtual; abstract;
+ procedure Delete(Index: integer); virtual; abstract;
+ procedure EndUpdate;
+ function Equals(aStrings: TWideStrings): Boolean;
+ procedure Exchange(Index1, Index2: integer); virtual;
+ function GetText: PWideChar; virtual;
+ function IndexOf(const S: WideString): integer; virtual;
+ function IndexOfName(const Name: WideString): integer;
+ function IndexOfObject(AObject: TObject): integer;
+ procedure Insert(Index: integer; const S: WideString); virtual; abstract;
+ procedure InsertObject(Index: integer; const S: WideString; AObject: TObject);
+ procedure LoadFromFile(const FileName: string); virtual;
+ procedure LoadFromStream(Stream: TStream); virtual;
+ procedure Move(CurIndex, NewIndex: integer); virtual;
+ procedure SaveToFile(const FileName: string); virtual;
+ procedure SaveToStream(Stream: TStream); virtual;
+ procedure SetText(aText: PWideChar); virtual;
+ property Capacity: integer read GetCapacity write SetCapacity;
+ property CommaText: WideString read GetCommaText write SetCommaText;
+ property Count: integer read GetCount;
+ property Names[Index: integer]: WideString read GetName;
+ property Objects[Index: integer]: TObject read GetObject write PutObject;
+ property Values[const Name: WideString]: WideString read GetValue write SetValue;
+ property Strings[Index: integer]: WideString read Get write Put; default;
+ property Text: WideString read GetTextStr write SetTextStr;
+ end;
+
+
+ PWideStringItem = ^TWideStringItem;
+
+ TWideStringItem = record
+ FString: WideString;
+ FObject: TObject;
+ end;
+
+
+ PWideStringItemList = ^TWideStringItemList;
+ TWideStringItemList = array[0..MaxListSize] of TWideStringItem;
+
+
+ { A WideString version of TStringList class. }
+ TWideStringList = class(TWideStrings)
+ private
+ FList: PStringItemList;
+ FCount: integer;
+ FCapacity: integer;
+ FSorted: Boolean;
+ FDuplicates: TDuplicates;
+ FOnChange: TNotifyEvent;
+ FOnChanging: TNotifyEvent;
+ procedure ExchangeItems(Index1, Index2: integer);
+ procedure Grow;
+ procedure QuickSort(L, R: integer);
+ procedure InsertItem(Index: integer; const S: WideString);
+ procedure SetSorted(Value: Boolean);
+ protected
+ procedure Changed; virtual;
+ procedure Changing; virtual;
+ function Get(Index: integer): WideString; override;
+ function GetCapacity: integer; override;
+ function GetCount: integer; override;
+ function GetObject(Index: integer): TObject; override;
+ procedure Put(Index: integer; const S: WideString); override;
+ procedure PutObject(Index: integer; AObject: TObject); override;
+ procedure SetCapacity(NewCapacity: integer); override;
+ procedure SetUpdateState(Updating: Boolean); override;
+ public
+ destructor Destroy; override;
+ function Add(const S: WideString): integer; override;
+ procedure Clear; override;
+ procedure Delete(Index: integer); override;
+ procedure Exchange(Index1, Index2: integer); override;
+ function Find(const S: WideString; var Index: integer): Boolean; virtual;
+ function IndexOf(const S: WideString): integer; override;
+ procedure Insert(Index: integer; const S: WideString); override;
+ procedure Sort; virtual;
+ property Duplicates: TDuplicates read FDuplicates write FDuplicates;
+ property Sorted: Boolean read FSorted write SetSorted;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
+ end;
+
+{$Warnings on}
+
+function WideQuotedStr(const S: WideString; Quote: widechar): WideString;
+function WideExtractQuotedStr(var S: WideString; Quote: widechar): WideString;
+function utf8(const utf8str: string): widestring;
+function u8(const utf8str: string): widestring;
+function wsToUtf8(const wstr: widestring): string;
+
+
+implementation
+
+
+uses
+ RTLConsts;
+
+const
+ BOM: word = $FFFE; // Byte Order Mark
+
+function WideQuotedStr(const S: WideString; Quote: widechar): WideString;
+var
+ slen: integer;
+ i: integer;
+begin
+ Result := Quote + S + Quote;
+ slen := length(Result);
+ i := 2;
+ while i < slen do
+ begin
+ if Result[i] = quote then
+ begin
+ insert(quote, Result, i);
+ Inc(i);
+ Inc(slen);
+ end;
+ Inc(i);
+ end;
+end;
+
+function WideExtractQuotedStr(var S: widestring; Quote: widechar): WideString;
+var
+ i: integer;
+ slen: integer;
+begin
+ if length(s) < 2 then
+ Result := s
+ else
+ begin
+ Result := copy(s, 2, length(s) - 2);
+ slen := length(Result);
+ i := 1;
+ while i < slen do
+ begin
+ if (Result[i] = quote) and (Result[i + 1] = quote) then
+ begin
+ Delete(Result, i, 1);
+ Dec(slen);
+ end;
+ Inc(i);
+ end;
+ end;
+end;
+
+function utf8(const utf8str: string): widestring;
+begin
+ Result := UTF8Decode(utf8str);
+end;
+
+function u8(const utf8str: string): widestring;
+begin
+ Result := UTF8Decode(utf8str);
+end;
+
+function wsToUtf8(const wstr: widestring): string;
+begin
+ Result := UTF8Encode(wstr);
+end;
+
+constructor TWideStrings.Create;
+begin
+ inherited;
+end;
+
+function TWideStrings.Add(const S: WideString): integer;
+begin
+ Result := GetCount;
+ Insert(Result, S);
+end;
+
+function TWideStrings.AddObject(const S: WideString; AObject: TObject): integer;
+begin
+ Result := Add(S);
+ PutObject(Result, AObject);
+end;
+
+procedure TWideStrings.Append(const S: WideString);
+begin
+ Add(S);
+end;
+
+procedure TWideStrings.AddStrings(aStrings: TWideStrings);
+var
+ I: integer;
+begin
+ BeginUpdate;
+ try
+ for I := 0 to aStrings.Count - 1 do
+ AddObject(aStrings[I], aStrings.Objects[I]);
+ finally
+ EndUpdate;
+ end;
+end;
+
+procedure TWideStrings.Assign(Source: TPersistent);
+var
+ I: integer;
+begin
+ if Source is TWideStrings then
+ begin
+ BeginUpdate;
+ try
+ Clear;
+ AddStrings(TWideStrings(Source));
+ finally
+ EndUpdate;
+ end;
+ Exit;
+ end
+ else if Source is TStrings then
+ begin
+ BeginUpdate;
+ try
+ for I := 0 to TStrings(Source).Count - 1 do
+ AddObject(TStrings(Source)[I], TStrings(Source).Objects[I]);
+ finally
+ EndUpdate;
+ end;
+ end;
+ inherited Assign(Source);
+end;
+
+procedure TWideStrings.BeginUpdate;
+begin
+ if FUpdateCount = 0 then
+ SetUpdateState(True);
+ Inc(FUpdateCount);
+end;
+
+procedure TWideStrings.DefineProperties(Filer: TFiler);
+
+ function DoWrite: Boolean;
+ begin
+ if Filer.Ancestor <> nil then
+ begin
+ Result := True;
+ if Filer.Ancestor is TWideStrings then
+ Result := not Equals(TWideStrings(Filer.Ancestor));
+ end
+ else
+ Result := Count > 0;
+ end;
+
+begin
+ Filer.DefineProperty('WideStrings', @ReadData, @WriteData, DoWrite);
+end;
+
+procedure TWideStrings.EndUpdate;
+begin
+ Dec(FUpdateCount);
+ if FUpdateCount = 0 then
+ SetUpdateState(False);
+end;
+
+function TWideStrings.Equals(aStrings: TWideStrings): Boolean;
+var
+ I, cnt: integer;
+begin
+ Result := False;
+ cnt := GetCount;
+ if cnt <> aStrings.GetCount then
+ Exit;
+ for I := 0 to cnt - 1 do
+ if Get(I) <> aStrings.Get(I) then
+ Exit;
+ Result := True;
+end;
+
+procedure TWideStrings.Error(const Msg: string; Data: integer);
+begin
+ raise EStringListError.CreateFmt(Msg, [Data]);
+end;
+
+procedure TWideStrings.Exchange(Index1, Index2: integer);
+var
+ TempObject: TObject;
+ TempString: WideString;
+begin
+ BeginUpdate;
+ try
+ TempString := Strings[Index1];
+ TempObject := Objects[Index1];
+ Strings[Index1] := Strings[Index2];
+ Objects[Index1] := Objects[Index2];
+ Strings[Index2] := TempString;
+ Objects[Index2] := TempObject;
+ finally
+ EndUpdate;
+ end;
+end;
+
+function TWideStrings.GetCapacity: integer;
+begin
+ Result := Count;
+end;
+
+function TWideStrings.GetCommaText: WideString;
+var
+ S: WideString;
+ P: PWideChar;
+ I, cnt: integer;
+begin
+ cnt := GetCount;
+ if (cnt = 1) and (Get(0) = '') then
+ Result := '""'
+ else
+ begin
+ Result := '';
+ for I := 0 to cnt - 1 do
+ begin
+ S := Get(I);
+ P := PWideChar(S);
+ while not (P^ in [widechar(#0)..widechar(' '), widechar('"'), widechar(',')]) do
+ Inc(P);
+ if (P^ <> #0) then
+ S := WideQuotedStr(S, '"');
+
+ if I > 0 then
+ Result := Result + ',';
+ Result := Result + S;
+ end;
+ end;
+end;
+
+function TWideStrings.GetName(Index: integer): WideString;
+var
+ P: integer;
+begin
+ Result := Get(Index);
+ P := 1;
+ while Result[P] <> '=' do
+ Inc(P);
+ if P <> 0 then
+ SetLength(Result, P - 1)
+ else
+ SetLength(Result, 0);
+end;
+
+function TWideStrings.GetObject(Index: integer): TObject;
+begin
+ Result := nil;
+end;
+
+function TWideStrings.GetText: PWideChar;
+var
+ TempStr: WideString;
+begin
+ TempStr := GetTextStr;
+ Result := AllocMem(2 * Length(TempStr) + 10);
+ System.Move(TempStr[1], Result^, 2 * Length(TempStr) + 2);
+end;
+
+function TWideStrings.GetTextStr: WideString;
+var
+ I, L, Size, cnt: integer;
+ P: PWideChar;
+ S: WideString;
+begin
+ cnt := GetCount;
+ Size := 0;
+ for I := 0 to cnt - 1 do
+ Inc(Size, Length(Get(I)) + 2);
+ SetString(Result, nil, Size);
+ P := Pointer(Result);
+ for I := 0 to cnt - 1 do
+ begin
+ S := Get(I);
+ L := Length(S);
+ if L <> 0 then
+ begin
+ System.Move(Pointer(S)^, P^, L * 2);
+ Inc(P, L);
+ end;
+ P^ := #13;
+ Inc(P);
+ P^ := #10;
+ Inc(P);
+ end;
+end;
+
+function TWideStrings.GetValue(const Name: WideString): WideString;
+var
+ I: integer;
+begin
+ I := IndexOfName(Name);
+ if I >= 0 then
+ Result := Copy(Get(I), Length(Name) + 2, MaxInt)
+ else
+ Result := '';
+end;
+
+function TWideStrings.IndexOf(const S: WideString): integer;
+begin
+ for Result := 0 to GetCount - 1 do
+ if Get(Result) = S then
+ Exit;
+ Result := -1;
+end;
+
+function TWideStrings.IndexOfName(const Name: WideString): integer;
+var
+ P: integer;
+ S: string;
+begin
+ for Result := 0 to GetCount - 1 do
+ begin
+ S := Get(Result);
+ P := 1;
+
+ while S[P] <> '=' do
+ Inc(P);
+
+ if (P <> 0) and (Copy(S, 1, P - 1) = Name) then
+ Exit;
+ end;
+ Result := -1;
+end;
+
+function TWideStrings.IndexOfObject(AObject: TObject): integer;
+begin
+ for Result := 0 to GetCount - 1 do
+ if GetObject(Result) = AObject then
+ Exit;
+ Result := -1;
+end;
+
+procedure TWideStrings.InsertObject(Index: integer; const S: WideString; AObject: TObject);
+begin
+ Insert(Index, S);
+ PutObject(Index, AObject);
+end;
+
+procedure TWideStrings.LoadFromFile(const FileName: string);
+var
+ Stream: TStream;
+begin
+ Stream := TFileStream.Create(FileName, fmOpenRead);
+ try
+ LoadFromStream(Stream);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TWideStrings.LoadFromStream(Stream: TStream);
+var
+ Size: integer;
+ S: WideString;
+ Reverse: Boolean;
+ rBOM: word;
+ I: integer;
+begin
+ BeginUpdate;
+ try
+ Stream.Read(rBOM, 2);
+ Reverse := False;
+ if rBOM = $FEFF then
+ Reverse := True
+ else if rBOM <> $FFFE then
+ Stream.Seek(-2, soFromCurrent);
+
+ Size := Stream.Size - Stream.Position;
+ SetString(S, nil, Size div 2);
+ Stream.Read(Pointer(S)^, Size);
+ if Reverse then
+ for I := 1 to Length(S) do
+ S[I] := widechar(Swap(word(S[I])));
+ SetTextStr(S);
+ finally
+ EndUpdate;
+ end;
+end;
+
+procedure TWideStrings.Move(CurIndex, NewIndex: integer);
+var
+ TempObject: TObject;
+ TempString: WideString;
+begin
+ if CurIndex <> NewIndex then
+ begin
+ BeginUpdate;
+ try
+ TempString := Get(CurIndex);
+ TempObject := GetObject(CurIndex);
+ Delete(CurIndex);
+ InsertObject(NewIndex, TempString, TempObject);
+ finally
+ EndUpdate;
+ end;
+ end;
+end;
+
+procedure TWideStrings.Put(Index: integer; const S: WideString);
+var
+ TempObject: TObject;
+begin
+ TempObject := GetObject(Index);
+ Delete(Index);
+ InsertObject(Index, S, TempObject);
+end;
+
+procedure TWideStrings.PutObject(Index: integer; AObject: TObject);
+begin
+ // Empty
+end;
+
+procedure TWideStrings.ReadData(Reader: TReader);
+var
+ S: string;
+ W: WideString;
+ I: integer;
+ Z: integer;
+ N: word;
+begin
+ BeginUpdate;
+ try
+ Clear;
+ S := Reader.ReadString;
+ SetLength(W, Length(S) div 4);
+ for I := 1 to Length(S) div 4 do
+ begin
+ Val('$' + S[I * 4 - 3] + S[I * 4 - 2] + S[I * 4 - 1] + S[I * 2], N, Z);
+ W[I] := widechar(N);
+ end;
+ Text := W;
+ finally
+ EndUpdate;
+ end;
+end;
+
+procedure TWideStrings.SaveToFile(const FileName: string);
+var
+ Stream: TStream;
+begin
+ Stream := TFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(Stream);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TWideStrings.SaveToStream(Stream: TStream);
+var
+ S: WideString;
+begin
+ S := GetTextStr;
+ Stream.Write(BOM, 2);
+ Stream.WriteBuffer(Pointer(S)^, Length(S) * 2);
+end;
+
+procedure TWideStrings.SetCapacity(NewCapacity: integer);
+begin
+ // do nothing - descendants may optionally implement this method
+end;
+
+procedure TWideStrings.SetCommaText(const Value: WideString);
+var
+ s: WideString;
+ i: integer;
+ inquote: boolean;
+begin
+ BeginUpdate;
+
+ try
+ Clear;
+
+ inquote := False;
+ i := 1;
+ s := '';
+ while i <= length(Value) do
+ begin
+
+ if Value[i] = '"' then
+ begin
+ if inquote then
+ begin
+ if (i < length(Value)) and (Value[i] = '"') then
+ begin
+ s := s + '"';
+ Inc(i);
+ end
+ else
+ inquote := False;
+ end
+ else
+ begin
+ inquote := True;
+ end;
+ end
+ else if (Value[i] = ',') and not inquote then
+ begin
+ Add(s);
+ s := '';
+ end
+ else
+ s := s + Value[i];
+
+ Inc(i);
+ end;
+
+ if s <> '' then
+ Add(s);
+
+ finally
+ EndUpdate;
+ end;
+end;
+
+procedure TWideStrings.SetText(aText: PWideChar);
+begin
+ SetTextStr(aText);
+end;
+
+procedure TWideStrings.SetTextStr(const Value: WideString);
+var
+ P, Start: PWideChar;
+ S: WideString;
+begin
+ BeginUpdate;
+ try
+ Clear;
+ P := Pointer(Value);
+ if P <> nil then
+ while P^ <> #0 do
+ begin
+ Start := P;
+ while not (P^ in [widechar(#0), widechar(#10), widechar(#13)]) do
+ Inc(P);
+ SetString(S, Start, P - Start);
+ Add(S);
+ if P^ = #13 then
+ Inc(P);
+ if P^ = #10 then
+ Inc(P);
+ end;
+ finally
+ EndUpdate;
+ end;
+end;
+
+procedure TWideStrings.SetUpdateState(Updating: Boolean);
+begin
+ // Empty
+end;
+
+procedure TWideStrings.SetValue(const Name, Value: WideString);
+var
+ I: integer;
+begin
+ I := IndexOfName(Name);
+ if Value <> '' then
+ begin
+ if I < 0 then
+ I := Add('');
+ Put(I, Name + '=' + Value);
+ end
+ else if I >= 0 then
+ Delete(I);
+end;
+
+procedure TWideStrings.WriteData(Writer: TWriter);
+var
+ I: integer;
+ S: string;
+ W: WideString;
+begin
+ W := Text;
+ S := '';
+ for I := 1 to Length(W) do
+ S := S + IntToHex(word(W[1]), 4);
+ Writer.WriteString(S);
+end;
+
+{ TWideStringList }
+
+destructor TWideStringList.Destroy;
+begin
+ FOnChange := nil;
+ FOnChanging := nil;
+ inherited Destroy;
+ if FCount <> 0 then
+ Finalize(FList^[0], FCount);
+ FCount := 0;
+ SetCapacity(0);
+end;
+
+function TWideStringList.Add(const S: WideString): integer;
+begin
+ if not Sorted then
+ Result := FCount
+ else if Find(S, Result) then
+ case Duplicates of
+ dupIgnore: Exit;
+ dupError: Error(SDuplicateString, 0);
+ end;
+ InsertItem(Result, S);
+end;
+
+procedure TWideStringList.Changed;
+begin
+ if (FUpdateCount = 0) and Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+procedure TWideStringList.Changing;
+begin
+ if (FUpdateCount = 0) and Assigned(FOnChanging) then
+ FOnChanging(Self);
+end;
+
+procedure TWideStringList.Clear;
+begin
+ if FCount <> 0 then
+ begin
+ Changing;
+ Finalize(FList^[0], FCount);
+ FCount := 0;
+ SetCapacity(0);
+ Changed;
+ end;
+end;
+
+procedure TWideStringList.Delete(Index: integer);
+begin
+ if (Index < 0) or (Index >= FCount) then
+ Error(SListIndexError, Index);
+ Changing;
+ Finalize(FList^[Index]);
+ Dec(FCount);
+ if Index < FCount then
+ System.Move(FList^[Index + 1], FList^[Index],
+ (FCount - Index) * SizeOf(TStringItem));
+ Changed;
+end;
+
+procedure TWideStringList.Exchange(Index1, Index2: integer);
+begin
+ if (Index1 < 0) or (Index1 >= FCount) then
+ Error(SListIndexError, Index1);
+ if (Index2 < 0) or (Index2 >= FCount) then
+ Error(SListIndexError, Index2);
+ Changing;
+ ExchangeItems(Index1, Index2);
+ Changed;
+end;
+
+procedure TWideStringList.ExchangeItems(Index1, Index2: integer);
+var
+ Temp: integer;
+ Item1, Item2: PWideStringItem;
+begin
+ Item1 := @FList^[Index1];
+ Item2 := @FList^[Index2];
+ Temp := integer(Item1^.FString);
+ integer(Item1^.FString) := integer(Item2^.FString);
+ integer(Item2^.FString) := Temp;
+ Temp := integer(Item1^.FObject);
+ integer(Item1^.FObject) := integer(Item2^.FObject);
+ integer(Item2^.FObject) := Temp;
+end;
+
+function TWideStringList.Find(const S: WideString; var Index: integer): Boolean;
+var
+ L, H, I, C: integer;
+begin
+ Result := False;
+ L := 0;
+ H := FCount - 1;
+ while L <= H do
+ begin
+ I := (L + H) shr 1;
+ C := WideCompareText(FList^[I].FString, S);
+ if C < 0 then
+ L := I + 1
+ else
+ begin
+ H := I - 1;
+ if C = 0 then
+ begin
+ Result := True;
+ if Duplicates <> dupAccept then
+ L := I;
+ end;
+ end;
+ end;
+ Index := L;
+end;
+
+function TWideStringList.Get(Index: integer): WideString;
+begin
+ if (Index < 0) or (Index >= FCount) then
+ Error(SListIndexError, Index);
+ Result := FList^[Index].FString;
+end;
+
+function TWideStringList.GetCapacity: integer;
+begin
+ Result := FCapacity;
+end;
+
+function TWideStringList.GetCount: integer;
+begin
+ Result := FCount;
+end;
+
+function TWideStringList.GetObject(Index: integer): TObject;
+begin
+ if (Index < 0) or (Index >= FCount) then
+ Error(SListIndexError, Index);
+ Result := FList^[Index].FObject;
+end;
+
+procedure TWideStringList.Grow;
+var
+ Delta: integer;
+begin
+ if FCapacity > 64 then
+ Delta := FCapacity div 4
+ else if FCapacity > 8 then
+ Delta := 16
+ else
+ Delta := 4;
+ SetCapacity(FCapacity + Delta);
+end;
+
+function TWideStringList.IndexOf(const S: WideString): integer;
+begin
+ if not Sorted then
+ Result := inherited IndexOf(S)
+ else if not Find(S, Result) then
+ Result := -1;
+end;
+
+procedure TWideStringList.Insert(Index: integer; const S: WideString);
+begin
+ if Sorted then
+ Error(SSortedListError, 0);
+ if (Index < 0) or (Index > FCount) then
+ Error(SListIndexError, Index);
+ InsertItem(Index, S);
+end;
+
+procedure TWideStringList.InsertItem(Index: integer; const S: WideString);
+begin
+ Changing;
+ if FCount = FCapacity then
+ Grow;
+ if Index < FCount then
+ System.Move(FList^[Index], FList^[Index + 1],
+ (FCount - Index) * SizeOf(TStringItem));
+ with FList^[Index] do
+ begin
+ Pointer(FString) := nil;
+ FObject := nil;
+ FString := S;
+ end;
+ Inc(FCount);
+ Changed;
+end;
+
+procedure TWideStringList.Put(Index: integer; const S: WideString);
+begin
+ if Sorted then
+ Error(SSortedListError, 0);
+ if (Index < 0) or (Index >= FCount) then
+ Error(SListIndexError, Index);
+ Changing;
+ FList^[Index].FString := S;
+ Changed;
+end;
+
+procedure TWideStringList.PutObject(Index: integer; AObject: TObject);
+begin
+ if (Index < 0) or (Index >= FCount) then
+ Error(SListIndexError, Index);
+ Changing;
+ FList^[Index].FObject := AObject;
+ Changed;
+end;
+
+procedure TWideStringList.QuickSort(L, R: integer);
+var
+ I, J: integer;
+ P: WideString;
+begin
+ repeat
+ I := L;
+ J := R;
+ P := FList^[(L + R) shr 1].FString;
+ repeat
+ while WideCompareText(FList^[I].FString, P) < 0 do
+ Inc(I);
+ while WideCompareText(FList^[J].FString, P) > 0 do
+ Dec(J);
+ if I <= J then
+ begin
+ ExchangeItems(I, J);
+ Inc(I);
+ Dec(J);
+ end;
+ until I > J;
+ if L < J then
+ QuickSort(L, J);
+ L := I;
+ until I >= R;
+end;
+
+procedure TWideStringList.SetCapacity(NewCapacity: integer);
+begin
+ ReallocMem(FList, NewCapacity * SizeOf(TStringItem));
+ FCapacity := NewCapacity;
+end;
+
+procedure TWideStringList.SetSorted(Value: Boolean);
+begin
+ if FSorted <> Value then
+ begin
+ if Value then
+ Sort;
+ FSorted := Value;
+ end;
+end;
+
+procedure TWideStringList.SetUpdateState(Updating: Boolean);
+begin
+ if Updating then
+ Changing
+ else
+ Changed;
+end;
+
+procedure TWideStringList.Sort;
+begin
+ if not Sorted and (FCount > 1) then
+ begin
+ Changing;
+ QuickSort(0, FCount - 1);
+ Changed;
+ end;
+end;
+
+
+end.
+
diff --git a/src/corelib/gfx_utf8utils.pas b/src/corelib/gfx_utf8utils.pas
index a3bb9ad9..21b78297 100644
--- a/src/corelib/gfx_utf8utils.pas
+++ b/src/corelib/gfx_utf8utils.pas
@@ -1,6 +1,6 @@
{
Some handly UTF8 function copied from the Lazarus LCL. Comes from the LCLProc
- unit.Surely we can move this into FPC?
+ unit. Surely we can move this into FPC?
}
unit gfx_UTF8utils;
@@ -57,7 +57,7 @@ begin
end;
end;
-function UTF8CStringToUTF8String (SourceStart: PChar; SourceLen: SizeInt): string;
+function UTF8CStringToUTF8String(SourceStart: PChar; SourceLen: SizeInt): string;
var
Source: PChar;
Dest: PChar;
diff --git a/src/corelib/x11/fpgfx_package.lpk b/src/corelib/x11/fpgfx_package.lpk
index a3a9b033..c5aaf68a 100644
--- a/src/corelib/x11/fpgfx_package.lpk
+++ b/src/corelib/x11/fpgfx_package.lpk
@@ -1,6 +1,6 @@
<?xml version="1.0"?>
<CONFIG>
- <Package Version="2">
+ <Package Version="3">
<Name Value="fpgfx_package"/>
<Author Value="Graeme Geldenhuys"/>
<CompilerOptions>
@@ -24,7 +24,7 @@
<License Value="Modified LGPL
"/>
<Version Minor="5" Release="1"/>
- <Files Count="15">
+ <Files Count="16">
<Item1>
<Filename Value="x11_xft.pas"/>
<UnitName Value="x11_xft"/>
@@ -85,6 +85,10 @@
<Filename Value="gfx_impl.pas"/>
<UnitName Value="gfx_impl"/>
</Item15>
+ <Item16>
+ <Filename Value="../gfx_strings.pas"/>
+ <UnitName Value="gfx_strings"/>
+ </Item16>
</Files>
<RequiredPkgs Count="1">
<Item1>
diff --git a/src/corelib/x11/fpgfx_package.pas b/src/corelib/x11/fpgfx_package.pas
index b4d63034..58a3fcac 100644
--- a/src/corelib/x11/fpgfx_package.pas
+++ b/src/corelib/x11/fpgfx_package.pas
@@ -9,7 +9,7 @@ interface
uses
x11_xft, x11_keyconv, gfxbase, gfx_x11, fpgfx, gfx_stdimages, gfx_imgfmt_bmp,
gfx_widget, gfx_UTF8utils, gfx_extinterpolation, gfx_cmdlineparams,
- gfx_clipboard, gfx_utils, gfx_popupwindow, gfx_impl;
+ gfx_clipboard, gfx_utils, gfx_popupwindow, gfx_impl, gfx_strings;
implementation
generated by cgit v1.2.3-70-g09d2 (git 2.48.0) at 2025-01-17 02:24:46 +0000