LazUtils: Rename DictionaryStringList -> LookupStringList. Add the renamed files as new.

git-svn-id: trunk@49505 -

.gitattributes

@@ -2865,6 +2865,11 @@ components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpi
 components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpr svneol=native#text/plain
 components/lazutils/examples/DictionaryStringList/main.lfm svneol=native#text/plain
 components/lazutils/examples/DictionaryStringList/main.pas svneol=native#text/plain
+components/lazutils/examples/LookupStringList/ReadMe.txt svneol=native#text/plain
+components/lazutils/examples/LookupStringList/TDedupeDemo.lpi svneol=native#text/plain
+components/lazutils/examples/LookupStringList/TDedupeDemo.lpr svneol=native#text/pascal
+components/lazutils/examples/LookupStringList/main.lfm svneol=native#text/plain
+components/lazutils/examples/LookupStringList/main.pas svneol=native#text/pascal
 components/lazutils/fileutil.inc svneol=native#text/pascal
 components/lazutils/fileutil.pas svneol=native#text/pascal
 components/lazutils/fpcadds.pas svneol=native#text/pascal
@@ -2930,6 +2935,7 @@ components/lazutils/lazutils.pas svneol=native#text/pascal
 components/lazutils/lazutilsstrconsts.pas svneol=native#text/pascal
 components/lazutils/lconvencoding.pas svneol=native#text/pascal
 components/lazutils/lcsvutils.pas svneol=native#text/pascal
+components/lazutils/lookupstringlist.pas svneol=native#text/pascal
 components/lazutils/masks.pas svneol=native#text/pascal
 components/lazutils/paswstring.pas svneol=native#text/pascal
 components/lazutils/test/TestLazStorageMem.lpi svneol=native#text/plain
@@ -4560,6 +4566,7 @@ docs/xml/lazutils/lazutilities.xml svneol=native#text/plain
 docs/xml/lazutils/lazutils.xml svneol=native#text/plain
 docs/xml/lazutils/lazutilsstrconsts.xml svneol=native#text/plain
 docs/xml/lazutils/lconvencoding.xml svneol=native#text/plain
+docs/xml/lazutils/lookupstringlist.xml svneol=native#text/plain
 docs/xml/lazutils/masks.xml svneol=native#text/plain
 docs/xml/lazutils/paswstring.xml svneol=native#text/plain
 docs/xml/lazutils/ttcache.xml svneol=native#text/plain

components/lazutils/examples/LookupStringList/ReadMe.txt

@@ -0,0 +1,3 @@
+Demonstrate how TLookupStringList can quickly remove duplicates from a list without changing the order.
+
+Author: Antônio Galvão

components/lazutils/examples/LookupStringList/TDedupeDemo.lpi

@@ -0,0 +1,83 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="TDedupeDemo"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="TDedupeDemo.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="main.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="Main"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="TDedupeDemo"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

components/lazutils/examples/LookupStringList/TDedupeDemo.lpr

@@ -0,0 +1,20 @@
+program TDedupeDemo;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, Main;
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource := True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

components/lazutils/examples/LookupStringList/main.lfm

@@ -0,0 +1,90 @@
+object Form1: TForm1
+  Left = 353
+  Height = 353
+  Top = 194
+  Width = 535
+  BorderStyle = bsSingle
+  Caption = 'TLookupStringList Demo'
+  ClientHeight = 353
+  ClientWidth = 535
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  OnShow = FormShow
+  Position = poScreenCenter
+  LCLVersion = '1.5'
+  object btnDedupeMemo: TButton
+    Left = 346
+    Height = 25
+    Top = 72
+    Width = 183
+    Anchors = [akTop, akRight]
+    Caption = 'Dedupe Memo'
+    OnClick = btnDedupeMemoClick
+    TabOrder = 0
+  end
+  object Memo: TMemo
+    Left = 0
+    Height = 281
+    Top = 72
+    Width = 336
+    ScrollBars = ssAutoBoth
+    TabOrder = 1
+  end
+  object lblTime: TLabel
+    Left = 16
+    Height = 17
+    Top = 48
+    Width = 32
+    Caption = 'Time:'
+    ParentColor = False
+  end
+  object lblLines: TLabel
+    Left = 130
+    Height = 17
+    Top = 48
+    Width = 98
+    Caption = 'Duplicated Lines:'
+    ParentColor = False
+  end
+  object SpinEdit1: TSpinEdit
+    Left = 8
+    Height = 23
+    Top = 8
+    Width = 94
+    Increment = 1000
+    MaxValue = 1000000000
+    TabOrder = 2
+  end
+  object btnGenerate: TButton
+    Left = 112
+    Height = 25
+    Top = 8
+    Width = 125
+    Caption = 'Generate Data'
+    OnClick = btnGenerateClick
+    TabOrder = 3
+  end
+  object btnDedupeFile: TButton
+    AnchorSideLeft.Control = btnDedupeMemo
+    AnchorSideRight.Control = btnDedupeMemo
+    AnchorSideRight.Side = asrBottom
+    Left = 346
+    Height = 32
+    Top = 232
+    Width = 183
+    Anchors = [akTop, akLeft, akRight]
+    Caption = 'Create File and Dedupe it'
+    OnClick = btnDedupeFileClick
+    TabOrder = 4
+  end
+  object Label1: TLabel
+    Left = 346
+    Height = 64
+    Top = 168
+    Width = 182
+    AutoSize = False
+    Caption = 'Deduplicating from a file is very much faster than using a GUI control. Use the button below to see the whole process.'
+    ParentColor = False
+    WordWrap = True
+  end
+end

components/lazutils/examples/LookupStringList/main.pas

@@ -0,0 +1,154 @@
+unit Main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Math, Forms, Controls, Dialogs, StdCtrls, Spin,
+  LookupStringList;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    btnDedupeMemo: TButton;
+    btnDedupeFile: TButton;
+    btnGenerate: TButton;
+    Label1 :TLabel;
+    lblLines: TLabel;
+    lblTime: TLabel;
+    Memo: TMemo;
+    SpinEdit1: TSpinEdit;
+    procedure btnDedupeFileClick(Sender: TObject);
+    procedure btnGenerateClick(Sender: TObject);
+    procedure btnDedupeMemoClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+  private
+    inList :TStringList;
+    procedure UpdateDuplicates(aDuplicateCount: string);
+    procedure UpdateTime(aTime: TDateTime);
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.UpdateDuplicates(aDuplicateCount: string);
+begin
+  lblLines.Caption := 'Duplicated Lines: ' + aDuplicateCount;
+end;
+
+procedure TForm1.UpdateTime(aTime: TDateTime);
+begin
+  lblTime.Caption := 'Time: ' + TimeToStr(aTime);
+end;
+
+procedure TForm1.btnGenerateClick(Sender: TObject);
+var
+  i, j: Integer;
+  s :string;
+begin
+  UpdateDuplicates('?');
+  UpdateTime(0);
+  Memo.Clear;
+  Application.ProcessMessages;
+  Screen.Cursor := crHourGlass;
+  try
+    InList.Clear;
+    for i := 0 to SpinEdit1.Value - 1 do
+    begin
+      s := '';
+      for j := 0 to 5 do
+        s := s + chr(randomrange(97, 123));
+      InList.Add(s);
+    end;
+    Memo.Lines.Assign(inList);
+  finally
+    Screen.Cursor := crDefault;
+  end;
+end;
+
+procedure TForm1.btnDedupeMemoClick(Sender: TObject);
+var
+  DSL :TLookupStringList;
+  T :TDateTime;
+begin
+  Screen.Cursor := crHourGlass;
+  try
+    T := Now;
+    DSL := TLookupStringList.Create;
+    try
+      DSL.Assign(Memo.Lines);
+      UpdateDuplicates(IntToStr(Memo.Lines.Count - DSL.Count));
+      Memo.Lines.Assign(DSL);
+    finally
+      DSL.Free;
+    end;
+    UpdateTime(Now - T);
+  finally
+    Screen.Cursor := crDefault;
+  end;
+end;
+
+procedure TForm1.btnDedupeFileClick(Sender: TObject);
+var
+  T :TDateTime;
+  N :integer;
+  DSL :TLookupStringList;
+begin
+  lblTime.Caption := 'Time:';
+  lblLines.Caption := 'Duplicated lines:';
+  Application.ProcessMessages;
+
+  if Trim(Memo.Text) = '' then
+  begin
+    ShowMessage('Generating data. Please wait.');
+    btnGenerateClick(nil);
+  end;
+
+  ShowMessage('Saving memo to a file. Please wait.');
+  Memo.Lines.SaveToFile('temp.txt');
+  ShowMessage('Dedupping the file.');
+  T := Now;
+  N := Memo.Lines.Count;
+  DSL := TLookupStringList.Create;
+  try
+    DSL.LoadFromFile('temp.txt');
+    lblLines.Caption := 'Duplicated Lines: ' + IntToStr(N - DSL.Count);
+    DSL.SaveToFile('temp.txt');
+    lblTime.Caption := 'Time: ' + TimeToStr(Now - T);
+    ShowMessage('Deleting the file.');
+    DeleteFile('temp.txt');
+  finally
+    DSL.Free;
+  end;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  inList := TStringList.Create;
+  Randomize;
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  inList.Free;
+end;
+
+procedure TForm1.FormShow(Sender: TObject);
+begin
+  spinedit1.Value := 100000;
+end;
+
+end.

components/lazutils/lookupstringlist.pas

@@ -0,0 +1,169 @@
+{
+ *****************************************************************************
+  This file is part of the Lazarus Component Library (LCL)
+
+  See the file COPYING.modifiedLGPL.txt, included in this distribution,
+  for details about the license.
+ *****************************************************************************
+
+  Author: Juha Manninen / Antônio Galvão
+
+  Abstract:
+    This is an unsorted StringList with a fast lookup feature.
+     Internally it uses a map container to store the strings again
+      which is then used for Contains, IndexOf and Find methods.
+
+    The extra container does not reserve too much memory because the strings are
+     reference counted and not really copied.
+
+    All Duplicates property values are fully supported,
+     including dupIgnore and dupError, unlike in unsorted StringList.
+
+    This class is useful only when you must preserve the order in list, but
+     also need to do fast lookups to see if a string exists, or must prevent duplicates.
+}
+unit LookupStringList;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, AvgLvlTree;
+
+type
+
+  { TLookupStringList }
+
+  TLookupStringList = class(TStringList)
+  private
+    FMap: TStringMap;
+  protected
+    procedure InsertItem(Index: Integer; const S: string); override;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Assign(Source: TPersistent); override;
+    procedure Clear; override;
+    procedure Delete(Index: Integer); override;
+    function Add(const S: string): Integer; override;
+    function AddObject(const S: string; AObject: TObject): Integer; override;
+    function Contains(const S: string): Boolean; // A new function
+    function Find(const S: string; out Index: Integer): Boolean; override;
+    function IndexOf(const S: string): Integer; override;
+  end;
+
+  TDictionaryStringList = class(TLookupStringList)
+  end deprecated 'The class was renamed to TLookupStringList.';
+
+function Deduplicate(AStrings: TStrings): Boolean;
+
+implementation
+
+{
+  Removes duplicate strings (case sensitive) from AStrings.
+  When the AStrings owns and contains objects, the function will return false.
+}
+function Deduplicate(AStrings: TStrings): Boolean;
+var
+  DSL: TLookupStringList;
+begin
+  Result := False;
+  DSL := TLookupStringList.Create;
+  try
+    DSL.Assign(AStrings);
+    AStrings.Assign(DSL);
+    Result := True;
+  finally
+    DSL.Free;
+  end;
+end;
+
+{ TLookupStringList }
+
+constructor TLookupStringList.Create;
+begin
+  inherited Create;
+  FMap := TStringMap.Create(True);
+end;
+
+destructor TLookupStringList.Destroy;
+begin
+  FMap.Free;
+  inherited Destroy;
+end;
+
+procedure TLookupStringList.Assign(Source: TPersistent);
+begin
+  inherited Assign(Source);
+  if Source is TLookupStringList then
+    FMap.Assign(TLookupStringList(Source).FMap);
+end;
+
+procedure TLookupStringList.Clear;
+begin
+  inherited Clear;
+  FMap.Clear;
+end;
+
+procedure TLookupStringList.Delete(Index: Integer);
+var
+  s: String;
+begin
+  s := Strings[Index];
+  inherited Delete(Index);
+  // The string must not be deleted from map if there are duplicates.
+  // Calling IndexOf is slow but it is needed.
+  if (Duplicates <> dupAccept) or (inherited IndexOf(s) = -1) then
+    FMap.Remove(s);
+end;
+
+function TLookupStringList.Add(const S: string): Integer;
+begin
+  if not Sorted and (Duplicates = dupIgnore) and FMap.Contains(S) then
+    Result := -1
+  else
+    Result := inherited Add(S);
+end;
+
+function TLookupStringList.AddObject(const S: string; AObject: TObject): Integer;
+begin
+  Result := Add(S);
+  if Result > -1 then
+    Objects[Result] := AObject;
+end;
+
+procedure TLookupStringList.InsertItem(Index: Integer; const S: string);
+begin
+  if not Sorted and (Duplicates <> dupAccept) then
+    if FMap.Contains(S) then
+      case Duplicates of
+        DupIgnore : Exit;
+        DupError : raise Exception.Create('TLookupStringList.InsertItem:'
+                                         +' Duplicates are not allowed.');
+      end;
+  inherited InsertItem(Index, S);
+  FMap.Add(S);     // Insert string to map, too.
+end;
+
+function TLookupStringList.Contains(const S: string): Boolean;
+begin
+  Result := FMap.Contains(S);
+end;
+
+function TLookupStringList.Find(const S: string; out Index: Integer): Boolean;
+begin
+  Index := IndexOf(S);
+  Result := Index <> -1;
+end;
+
+function TLookupStringList.IndexOf(const S: string): Integer;
+begin
+  if FMap.Contains(S) then
+    Result := inherited IndexOf(S)
+  else
+    Result := -1
+end;
+
+end.
+

docs/xml/lazutils/lookupstringlist.xml

@@ -0,0 +1,245 @@
+<?xml version="1.0" encoding="ISO-8859-1"?>
+<fpdoc-descriptions>
+<package name="lazutils">
+
+<!--
+  ====================================================================
+    LookupStringList
+  ====================================================================
+-->
+
+<module name="LookupStringList">
+<short></short>
+<descr>
+</descr>
+
+<!-- class Visibility: default -->
+<element name="TLookupStringList">
+<short></short>
+<descr>
+</descr>
+<errors>
+</errors>
+<seealso>
+</seealso>
+</element>
+
+<!-- variable Visibility: private -->
+<element name="TLookupStringList.FMap">
+<short></short>
+<descr>
+</descr>
+<seealso>
+</seealso>
+</element>
+
+<!-- procedure Visibility: protected -->
+<element name="TLookupStringList.InsertItem">
+<short></short>
+<descr>
+</descr>
+<errors>
+</errors>
+<seealso>
+</seealso>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="TLookupStringList.InsertItem.Index">
+<short></short>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="TLookupStringList.InsertItem.S">
+<short></short>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="TLookupStringList.InsertItem.O">
+<short></short>
+</element>
+
+<!-- constructor Visibility: public -->
+<element name="TLookupStringList.Create">
+<short></short>
+<descr>
+</descr>
+<errors>
+</errors>
+<seealso>
+</seealso>
+</element>
+
+<!-- destructor Visibility: public -->
+<element name="TLookupStringList.Destroy">
+<short></short>
+<descr>
+</descr>
+<errors>
+</errors>
+<seealso>
+</seealso>
+</element>
+
+<!-- procedure Visibility: public -->
+<element name="TLookupStringList.Assign">
+<short></short>
+<descr>
+</descr>
+<errors>
+</errors>
+<seealso>
+</seealso>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="TLookupStringList.Assign.Source">
+<short></short>
+</element>
+
+<!-- procedure Visibility: public -->
+<element name="TLookupStringList.Clear">
+<short></short>
+<descr>
+</descr>
+<errors>
+</errors>
+<seealso>
+</seealso>
+</element>
+
+<!-- procedure Visibility: public -->
+<element name="TLookupStringList.Delete">
+<short></short>
+<descr>
+</descr>
+<errors>
+</errors>
+<seealso>
+</seealso>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="TLookupStringList.Delete.Index">
+<short></short>
+</element>
+
+<!-- function Visibility: public -->
+<element name="TLookupStringList.Add">
+<short></short>
+<descr>
+</descr>
+<errors>
+</errors>
+<seealso>
+</seealso>
+</element>
+
+<!-- function result Visibility: default -->
+<element name="TLookupStringList.Add.Result">
+<short></short>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="TLookupStringList.Add.S">
+<short></short>
+</element>
+
+<!-- function Visibility: public -->
+<element name="TLookupStringList.AddObject">
+<short></short>
+<descr>
+</descr>
+<errors>
+</errors>
+<seealso>
+</seealso>
+</element>
+
+<!-- function result Visibility: default -->
+<element name="TLookupStringList.AddObject.Result">
+<short></short>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="TLookupStringList.AddObject.S">
+<short></short>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="TLookupStringList.AddObject.AObject">
+<short></short>
+</element>
+
+<!-- function Visibility: public -->
+<element name="TLookupStringList.Contains">
+<short></short>
+<descr>
+</descr>
+<errors>
+</errors>
+<seealso>
+</seealso>
+</element>
+
+<!-- function result Visibility: default -->
+<element name="TLookupStringList.Contains.Result">
+<short></short>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="TLookupStringList.Contains.S">
+<short></short>
+</element>
+
+<!-- function Visibility: public -->
+<element name="TLookupStringList.Find">
+<short></short>
+<descr>
+</descr>
+<errors>
+</errors>
+<seealso>
+</seealso>
+</element>
+
+<!-- function result Visibility: default -->
+<element name="TLookupStringList.Find.Result">
+<short></short>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="TLookupStringList.Find.S">
+<short></short>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="TLookupStringList.Find.Index">
+<short></short>
+</element>
+
+<!-- function Visibility: public -->
+<element name="TLookupStringList.IndexOf">
+<short></short>
+<descr>
+</descr>
+<errors>
+</errors>
+<seealso>
+</seealso>
+</element>
+
+<!-- function result Visibility: default -->
+<element name="TLookupStringList.IndexOf.Result">
+<short></short>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="TLookupStringList.IndexOf.S">
+<short></short>
+</element>
+
+</module> <!-- LookupStringList -->
+
+</package>
+</fpdoc-descriptions>