jvcllaz: Add TJvSpellChecker incl demo and sample dictionaries

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6237 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/jvcllaz/run/JvCmp/JvSpellChecker.pas

@@ -0,0 +1,633 @@
+{-----------------------------------------------------------------------------
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/MPL-1.1.html
+
+Software distributed under the License is distributed on an "AS IS" basis,
+WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
+the specific language governing rights and limitations under the License.
+
+The Original Code is: JvSpellChecker.PAS, released on 2003-08-19.
+
+The Initial Developer of the Original Code is Peter Th�rnqvist [peter3 at sourceforge dot net]
+Portions created by Peter Th�rnqvist are Copyright (C) 2003 Peter Th�rnqvist.
+All Rights Reserved.
+
+Contributor(s):
+
+You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
+located at http://jvcl.delphi-jedi.org
+
+Known Issues:
+- Items in the UserDictionary are not added to the internal WordTable/SoundexTable when
+  you add a new item (i.e call UserDictionary.Add). This is mostly for performance.
+  UserDictionary entries are loaded into the dictionary table in BuildTables, so to get
+  them added make sure UserDictionary is filled before setting the Dictionary property.
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvSpellChecker;
+
+{$mode objfpc}{$H+}
+//{$I jvcl.inc}
+
+interface
+
+uses
+  SysUtils, Classes,
+  Windows, Controls, Messages,
+  JvSpellIntf; //, JvComponentBase;
+
+type
+  TJvSpellChecker = class(TComponent) //TJvComponent)
+  private
+    FSpellChecker: IJvSpellChecker;
+    procedure SetText(const Value: string);
+    function GetText: string;
+    function GetDictionary: TFileName;
+    function GetUserDictionary: TStrings;
+    procedure SetDictionary(const Value: TFileName);
+    procedure SetUserDictionary(const Value: TStrings);
+    function GetSpellChecker: IJvSpellChecker;
+    function GetDelimiters: TSysCharSet;
+    procedure SetDelimiters(const Value: TSysCharSet);
+    function GetIgnores: TStrings;
+    procedure SetIgnores(const Value: TStrings);
+    function GetCanIgnore: TJvSpellCheckIgnoreEvent;
+    procedure SetCanIgnore(const Value: TJvSpellCheckIgnoreEvent);
+  public
+    // reference to the actual spell check implementation
+    property SpellChecker: IJvSpellChecker read GetSpellChecker;
+    property Delimiters: TSysCharSet read GetDelimiters write SetDelimiters;
+  published
+    // Surface interface properties to make it a bit easier to work with this component
+    property Text: string read GetText write SetText;
+    property Dictionary: TFileName read GetDictionary write SetDictionary;
+    property UserDictionary: TStrings read GetUserDictionary write SetUserDictionary;
+    property Ignores: TStrings read GetIgnores write SetIgnores;
+    property OnCanIgnore: TJvSpellCheckIgnoreEvent read GetCanIgnore write SetCanIgnore;
+  end;
+
+{$IFDEF UNITVERSIONING}
+const
+  UnitVersioning: TUnitVersionInfo = (
+    RCSfile: '$URL$';
+    Revision: '$Revision$';
+    Date: '$Date$';
+    LogPath: 'JVCL\run'
+  );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+uses
+//  JclStrings, // StrAddRef, StrDecRef
+  JvTypes, JvResources;
+
+// NOTE: hash table and soundex lookup code originally from Julian Bucknall's
+// "Algorithms Alfresco" column in The Delphi Magazine, Issue 52, December 1999
+// Used with permission
+const
+  WordTableSize = 10007; {a prime}
+  SoundexTableSize = 26 * 7 * 7 * 7; {the exact number of Soundexes}
+  cDelimiters: TSysCharSet = [#0..#32, '.', ',', '<', '>', '=', '!', '?', ':', ';', '"', '''', '(', ')', '[', ']', '{', '}', '+', '|'];
+
+type
+  TSoundex = string[4];
+  // default implementation of the IJvSpellChecker interface. To provide a new implementation,
+  // assign a function to the CreateSpellChecker function variable in JvSpellIntf that returns an
+  // instance of your implementation. For more info, see InternalSpellChecker in this unit.
+  TJvDefaultSpellChecker = class(TInterfacedObject, IJvSpellChecker)
+  private
+    FText: string;
+    FCurrentWord: string;
+    FPosition: Integer;
+    FDictionary: string;
+    FSuggestions: TStringList;
+    FUserDictionary: TStringList;
+    FIgnores: TStringList;
+    FWordTable: TList;
+    FSoundexTable: TList;
+    FDelimiters: TSysCharSet;
+    FOnCanIgnore: TJvSpellCheckIgnoreEvent;
+    { IJvSpellChecker }
+    procedure SetDictionary(const Value: string);
+    function GetDictionary: string;
+    function GetUserDictionary: TStrings;
+    procedure SetUserDictionary(const Value: TStrings);
+    function GetSuggestions: TStrings;
+    function GetText: string;
+    procedure SetText(const Value: string);
+    function GetIgnores: TStrings;
+    procedure SetIgnores(const Value: TStrings);
+    function GetDelimiters: TSysCharSet;
+    procedure SetDelimiters(const Value: TSysCharSet);
+    function GetCanIgnore: TJvSpellCheckIgnoreEvent;
+    procedure SetCanIgnore(const Value: TJvSpellCheckIgnoreEvent);
+  protected
+    procedure BuildTables; virtual;
+    procedure ClearTables; virtual;
+    function GetCurrentWord: string; virtual;
+    procedure GetWordSuggestions(const Value: string; AStrings: TStrings); virtual;
+    procedure AddSoundex(ASoundex: TSoundex; const Value: string); virtual;
+    procedure AddWord(const Value: string); virtual;
+    function WordExists(const Value: string): Boolean; virtual;
+    function CanIgnore(const Value: string): Boolean; virtual;
+    { IJvSpellChecker }
+    function Next(out StartIndex, WordLength: Integer): WordBool; virtual;
+    procedure Seek(Position: Integer); virtual;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    property Delimiters: TSysCharSet read GetDelimiters write SetDelimiters;
+    property Suggestions: TStrings read GetSuggestions;
+    property Dictionary: string read GetDictionary write SetDictionary;
+    property UserDictionary: TStrings read GetUserDictionary write SetUserDictionary;
+    property Text: string read GetText write SetText;
+    property Ignores: TStrings read GetIgnores write SetIgnores;
+    property OnCanIgnore: TJvSpellCheckIgnoreEvent read GetCanIgnore write SetCanIgnore;
+  end;
+
+function InternalCreateSpellChecker: IJvSpellChecker;
+begin
+  // create our implementation of the spell checker interface
+  Result := TJvDefaultSpellChecker.Create;
+end;
+
+function Soundex(const Value: string): TSoundex;
+const
+  Encode: array ['A'..'Z'] of AnsiChar =
+   ('0', '1', '2', '3', '0', '1', '2', '/', '0', '2', '2',
+    '4', '5', '5', '0', '1', '2', '6', '2', '3', '0', '1',
+    '/', '2', '0', '2');
+var
+  Ch: Char;
+  Code, OldCode: AnsiChar;
+  SxInx: Integer;
+  I: Integer;
+  UpperValue: string;
+begin
+  Result := 'A000';
+  if Value = '' then
+    Exit;
+//    raise Exception.Create('Soundex: input string is empty');
+  UpperValue := AnsiUpperCase(Value);
+
+  Ch := UpperValue[1];
+  if (Ch < 'A') or (Ch > 'Z') then
+    Ch := 'A';
+//    raise Exception.Create('Soundex: unknown character in input string');
+  Result[1] := AnsiChar(Ch);
+  Code := Encode[Ch];
+  OldCode := Code;
+  SxInx := 2;
+  for I := 2 to Length(UpperValue) do
+  begin
+    if (Code <> '/') then
+      OldCode := Code;
+    Ch := UpperValue[I];
+    if not ('A' <= Ch) and (Ch <= 'Z') then
+      Code := '0'
+    else
+      Code := Encode[Ch];
+    if (Code <> OldCode) and (Code > '0') then
+    begin
+      Result[SxInx] := Code;
+      Inc(SxInx);
+      if SxInx > 4 then
+        Break;
+    end;
+  end;
+end;
+
+function ELFHash(const S: string): Integer;
+var
+  G, I: Integer;
+begin
+  Result := 0;
+  for I := 1 to Length(S) do
+  begin
+    Result := (Result shl 4) + Ord(S[I]);
+    G := Result and Longint($F0000000);
+    if G <> 0 then
+      Result := Result xor (G shr 24);
+    Result := Result and (not G);
+  end;
+end;
+
+function SoundexHash(const S: TSoundex): Integer;
+begin
+  Result :=
+    ((Ord(S[1]) - Ord('A')) * 343) +
+    ((Ord(S[2]) - Ord('0')) * 49) +
+    ((Ord(S[3]) - Ord('0')) * 7) +
+     (Ord(S[4]) - Ord('0'));
+end;
+
+function GetNextWord(var S: PChar; out Word: string; Delimiters: TSysCharSet): Boolean;
+var
+  Start: PChar;
+begin
+  Word := '';
+  Result := S = nil;
+  if Result then
+    Exit;
+  Start := nil;
+  while True do
+  begin
+    if S^ = #0 then
+    begin
+      Word := Start;
+      Result := Start <> nil;
+      Exit;
+    end
+    else
+    if ((S^ <= #255) and (AnsiChar(S^) in Delimiters)) then
+    begin
+      if Start <> nil then
+      begin
+        SetString(Word, Start, S - Start);
+        Exit;
+      end
+      else
+        while ((S^ <= #255) and (AnsiChar(S^) in Delimiters)) and (S^ <> #0) do
+          Inc(S);
+    end
+    else
+    begin
+      if Start = nil then
+        Start := S;
+      Inc(S);
+    end;
+  end;
+end;
+
+//=== { TJvDefaultSpellChecker } =============================================
+
+constructor TJvDefaultSpellChecker.Create;
+begin
+  inherited Create;
+  FDelimiters := cDelimiters;
+  FSuggestions := TStringList.Create;
+  FUserDictionary := TStringList.Create;
+  FUserDictionary.Sorted := True;
+  FIgnores := TStringList.Create;
+  FIgnores.Sorted := True;
+
+  FWordTable := TList.Create;
+  FWordTable.Count := WordTableSize;
+  FSoundexTable := TList.Create;
+  FSoundexTable.Count := SoundexTableSize;
+end;
+
+destructor TJvDefaultSpellChecker.Destroy;
+begin
+  ClearTables;
+  FreeAndNil(FSuggestions);
+  FreeAndNil(FUserDictionary);
+  FreeAndNil(FWordTable);
+  FreeAndNil(FSoundexTable);
+  FreeAndNil(FIgnores);
+  inherited Destroy;
+end;
+
+procedure TJvDefaultSpellChecker.AddSoundex(ASoundex: TSoundex; const Value: string);
+var
+  Hash: Integer;
+begin
+  Hash := SoundexHash(ASoundex) mod SoundexTableSize;
+  if FSoundexTable[Hash] = nil then
+    FSoundexTable[Hash] := TStringList.Create;
+  TStringList(FSoundexTable[Hash]).Add(Value);
+end;
+
+procedure TJvDefaultSpellChecker.AddWord(const Value: string);
+var
+  Hash: Integer;
+begin
+  Hash := ELFHash(Value) mod WordTableSize;
+  if FWordTable[Hash] = nil then
+    FWordTable[Hash] := TStringList.Create;
+  TStringList(FWordTable[Hash]).Add(Value);
+end;
+
+procedure TJvDefaultSpellChecker.BuildTables;
+var
+  AFile: TextFile;
+  Value: string;
+  LastValue: string;
+  SoundexVal: TSoundex;
+  I: Integer;
+  N: Integer;
+begin
+  ClearTables;
+  if FileExists(Dictionary) then
+  begin
+    System.Assign(AFile, Dictionary);
+    System.Reset(AFile);
+    try
+      repeat
+        ReadLn(AFile, Value);
+        if Value <> '' then
+        begin
+          // (rom) simple compession for dictionary
+          N := Ord(Value[1]) - Ord('0');
+          Value := Copy(Value, 2, Length(Value) - 1);
+          if N > 0 then
+            Value := Copy(LastValue, 1, N) + Value;
+          LastValue := Value;
+
+          Value := AnsiLowerCase(Value);
+          AddWord(Value);
+          SoundexVal := Soundex(Value);
+          AddSoundex(SoundexVal, Value);
+        end;
+      until Eof(AFile);
+    finally
+      System.Close(AFile);
+    end;
+    for I := 0 to UserDictionary.Count - 1 do
+      if UserDictionary[I] <> '' then
+      begin
+        Value := AnsiLowerCase(UserDictionary[I]);
+        AddWord(Value);
+        SoundexVal := Soundex(Value);
+        AddSoundex(SoundexVal, Value);
+      end;
+  end;
+end;
+
+procedure TJvDefaultSpellChecker.ClearTables;
+var
+  I: Integer;
+begin
+  if FSoundexTable <> nil then
+    for I := 0 to FSoundexTable.Count - 1 do
+    begin
+      TObject(FSoundexTable[I]).Free;
+      FSoundexTable[I] := nil;
+    end;
+
+  if FWordTable <> nil then
+    for I := 0 to FWordTable.Count - 1 do
+    begin
+      TObject(FWordTable[I]).Free;
+      FWordTable[I] := nil;
+    end;
+end;
+
+function TJvDefaultSpellChecker.GetSuggestions: TStrings;
+begin
+  Result := FSuggestions;
+end;
+
+function TJvDefaultSpellChecker.GetText: string;
+begin
+  Result := FText;
+end;
+
+procedure TJvDefaultSpellChecker.GetWordSuggestions(const Value: string; AStrings: TStrings);
+var
+  SoundexVal: TSoundex;
+  Hash: Integer;
+begin
+  if AStrings <> nil then
+  begin
+    AStrings.BeginUpdate;
+    try
+      AStrings.Clear;
+      SoundexVal := Soundex(Value);
+      Hash := SoundexHash(SoundexVal) mod SoundexTableSize;
+      if FSoundexTable[Hash] <> nil then
+        AStrings.AddStrings(TStringList(FSoundexTable[Hash]));
+    finally
+      AStrings.EndUpdate;
+    end;
+  end;
+end;
+
+function TJvDefaultSpellChecker.Next(out StartIndex, WordLength: Integer): WordBool;
+var
+  S: PChar;
+begin
+  StartIndex := 0;
+  WordLength := 0;
+  Result := False;
+  if FPosition <= 0 then
+    FPosition := 1;
+  if FPosition >= Length(FText) then
+    Exit;
+  S := PChar(Text) + FPosition - 1;
+  if (S = nil) or (S^ = #0) or (Trim(S) = '') then
+    Exit;
+  while True do
+  begin
+    FCurrentWord := '';
+    GetNextWord(S, FCurrentWord, Delimiters);
+    WordLength := Length(FCurrentWord);
+    StartIndex := S - PChar(Text) - WordLength + 1;
+    FPosition := StartIndex + WordLength;
+    if (FCurrentWord <> '') and not CanIgnore(FCurrentWord) then
+    begin
+      FSuggestions.Clear;
+      Result := not WordExists(FCurrentWord);
+      if Result then
+      begin
+        GetWordSuggestions(FCurrentWord, FSuggestions);
+        Break;
+      end;
+    end;
+    if (S = nil) or (S^ = #0) or (Trim(S) = '') then
+    begin
+      Result := False;
+      Break;
+    end;
+  end;
+end;
+
+procedure TJvDefaultSpellChecker.Seek(Position: Integer);
+begin
+  FPosition := Position;
+end;
+
+procedure TJvDefaultSpellChecker.SetText(const Value: string);
+begin
+  FText := Value;
+  FPosition := 1;
+end;
+
+function TJvDefaultSpellChecker.WordExists(const Value: string): Boolean;
+var
+  I: Integer;
+  Hash: Integer;
+  List: TStringList;
+  FWord: string;
+begin
+  FWord := AnsiLowerCase(Value);
+  Hash := ELFHash(FWord) mod WordTableSize;
+  if FWordTable[Hash] <> nil then
+  begin
+    List := TStringList(FWordTable[Hash]);
+    for I := 0 to List.Count - 1 do
+      if AnsiSameText(PChar(List[I]), FWord) then
+      begin
+        Result := True;
+        Exit;
+      end;
+  end;
+  // ignore or user word?
+  Result := (UserDictionary.IndexOf(FWord) > -1) or (Ignores.IndexOf(FWord) > -1);
+end;
+
+function TJvDefaultSpellChecker.GetDictionary: string;
+begin
+  Result := FDictionary;
+end;
+
+function TJvDefaultSpellChecker.GetUserDictionary: TStrings;
+begin
+  Result := FUserDictionary;
+end;
+
+procedure TJvDefaultSpellChecker.SetDictionary(const Value: string);
+begin
+  if FDictionary <> Value then
+  begin
+    FDictionary := Value;
+    BuildTables;
+  end;
+end;
+
+procedure TJvDefaultSpellChecker.SetUserDictionary(const Value: TStrings);
+begin
+  FUserDictionary.Assign(Value);
+end;
+
+function TJvDefaultSpellChecker.GetIgnores: TStrings;
+begin
+  Result := FIgnores;
+end;
+
+procedure TJvDefaultSpellChecker.SetIgnores(const Value: TStrings);
+begin
+  FIgnores.Assign(Value);
+end;
+
+function TJvDefaultSpellChecker.GetDelimiters: TSysCharSet;
+begin
+  Result := FDelimiters;
+end;
+
+procedure TJvDefaultSpellChecker.SetDelimiters(const Value: TSysCharSet);
+begin
+  FDelimiters := Value;
+end;
+
+function TJvDefaultSpellChecker.CanIgnore(const Value: string): Boolean;
+begin
+  Result := False;
+  if Assigned(FOnCanIgnore) then
+    FOnCanIgnore(Self, Value, Result);
+end;
+
+function TJvDefaultSpellChecker.GetCanIgnore: TJvSpellCheckIgnoreEvent;
+begin
+  Result := FOnCanIgnore;
+end;
+
+procedure TJvDefaultSpellChecker.SetCanIgnore(const Value: TJvSpellCheckIgnoreEvent);
+begin
+  FOnCanIgnore := Value;
+end;
+
+function TJvDefaultSpellChecker.GetCurrentWord: string;
+begin
+  Result := FCurrentWord;
+end;
+
+//=== { TJvSpellChecker } ====================================================
+
+function TJvSpellChecker.GetCanIgnore: TJvSpellCheckIgnoreEvent;
+begin
+  Result := SpellChecker.OnCanIgnore;
+end;
+
+function TJvSpellChecker.GetDelimiters: TSysCharSet;
+begin
+  Result := SpellChecker.Delimiters;
+end;
+
+function TJvSpellChecker.GetDictionary: TFileName;
+begin
+  Result := SpellChecker.Dictionary;
+end;
+
+function TJvSpellChecker.GetIgnores: TStrings;
+begin
+  Result := SpellChecker.Ignores;
+end;
+
+function TJvSpellChecker.GetSpellChecker: IJvSpellChecker;
+begin
+  if FSpellChecker = nil then
+  begin
+    if Assigned(CreateSpellChecker) then
+      FSpellChecker := CreateSpellChecker()
+    else
+      FSpellChecker := InternalCreateSpellChecker;
+  end;
+  Result := FSpellChecker;
+end;
+
+function TJvSpellChecker.GetText: string;
+begin
+  Result := SpellChecker.GetText;
+end;
+
+function TJvSpellChecker.GetUserDictionary: TStrings;
+begin
+  Result := SpellChecker.UserDictionary;
+end;
+
+procedure TJvSpellChecker.SetCanIgnore(const Value: TJvSpellCheckIgnoreEvent);
+begin
+  SpellChecker.OnCanIgnore := Value;
+end;
+
+procedure TJvSpellChecker.SetDelimiters(const Value: TSysCharSet);
+begin
+  SpellChecker.Delimiters := Value;
+end;
+
+procedure TJvSpellChecker.SetDictionary(const Value: TFileName);
+begin
+  SpellChecker.Dictionary := Value;
+end;
+
+procedure TJvSpellChecker.SetIgnores(const Value: TStrings);
+begin
+  SpellChecker.Ignores := Value;
+end;
+
+procedure TJvSpellChecker.SetText(const Value: string);
+begin
+  SpellChecker.SetText(Value);
+end;
+
+procedure TJvSpellChecker.SetUserDictionary(const Value: TStrings);
+begin
+  SpellChecker.UserDictionary := Value;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+  RegisterUnitVersion(HInstance, UnitVersioning);
+{$ENDIF UNITVERSIONING}
+
+{$IFDEF UNITVERSIONING}
+finalization
+  UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.

components/jvcllaz/run/JvCmp/JvSpellIntf.pas

@@ -0,0 +1,124 @@
+{-----------------------------------------------------------------------------
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/MPL-1.1.html
+
+Software distributed under the License is distributed on an "AS IS" basis,
+WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
+the specific language governing rights and limitations under the License.
+
+The Original Code is: JvSpellIntf.PAS, released on 2003-08-19.
+
+The Initial Developer of the Original Code is Peter Thörnqvist [peter3 at sourceforge dot net]
+Portions created by Peter Thörnqvist are Copyright (C) 2003 Peter Thörnqvist.
+All Rights Reserved.
+
+Contributor(s):
+
+You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
+located at http://jvcl.delphi-jedi.org
+
+Description:
+  Interface declarations for classes that want to implement a spell
+  checker compatible with the TJvSpellChecker component.
+
+Known Issues:
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvSpellIntf;
+
+{$mode objfpc}{$H+}
+//{$I jvcl.inc}
+
+interface
+
+uses
+  SysUtils, Classes;
+
+type
+  TJvSpellCheckIgnoreEvent = procedure(Sender: TObject; const Value: string;
+    var CanIgnore: Boolean) of object;
+
+  IJvSpellChecker = interface
+    ['{819CE37A-E3C1-4F54-B9E1-1CFAA8AFB887}']
+    // GetCurrentWord returns the currently found misspelled or missing word
+    function GetCurrentWord: string;
+    // Seek moves the internal text pointer to the position in Text given by Position.
+    // If Position >= Length(Text), calls to Next always returns false.
+    // Since positioning is 1-based, Seek(0) = Seek(1).
+    procedure Seek(Position: Integer);
+    // Next returns true if a misspelled word was found. If a misspelled word
+    // was found, StartIndex is set to the start of the word in Text and WordLength
+    // is set to the length of the word. Note that StartIndex is 1-based, i.e the first
+    // position in Text is 1. If Next returns false, it means that no more misspelled words
+    // can be found (i.e either when at end of Text or everything from the current point and
+    // onward is correctly spelled)
+    function Next(out StartIndex, WordLength: Integer): WordBool;
+    // The Text to spell check. When Text is changed, the internal position is reset
+    // to the start of Text (no need to call Seek)
+    function GetText: string;
+    procedure SetText(const Value: string);
+    property Text: string read GetText write SetText;
+    // Delimiters specifies the characters that are used to break strings into words.
+    function GetDelimiters: TSysCharSet;
+    procedure SetDelimiters(const Value: TSysCharSet);
+    property Delimiters: TSysCharSet read GetDelimiters write SetDelimiters;
+
+    // Adds the content of a dictionary to the internal list of words that are scanned for matches.
+    procedure SetDictionary(const Value: string);
+    function GetDictionary: string;
+    property Dictionary: string read GetDictionary write SetDictionary;
+    // "User" dictionary. This is a list of words, sorted.
+    // Manage the user dictionary by using the methods of TStrings.
+    // The main difference between a dictionary and a user dictionary is that you cannot change
+    // the content of the main dictionary from the interface. In addition, the UserDictionary is presumed to
+    // contain a list of words, one per line, sorted whereas the dictionary can be in any format (determined
+    // by the actual implementation).
+    function GetUserDictionary: TStrings;
+    procedure SetUserDictionary(const Value: TStrings);
+    property UserDictionary: TStrings read GetUserDictionary write SetUserDictionary;
+    // Ignores are used for words that should be ignored in the current session.
+    // To make an ignore persistent, you should call UserDictionary.Add
+    // and then save/load from file as needed.
+    function GetIgnores: TStrings;
+    procedure SetIgnores(const Value: TStrings);
+    property Ignores: TStrings read GetIgnores write SetIgnores;
+    // Suggestion returns the suggested replacements for a misspelled word. How the
+    // implementation determines valid and/or useful replacement words is defined
+    // by the implementation.
+    function GetSuggestions: TStrings;
+    property Suggestions: TStrings read GetSuggestions;
+    // Assign a handler to this event when you need to set up ignores for words
+    // that can't be captured using the ignore list and/or the user dictionary.
+    function GetCanIgnore: TJvSpellCheckIgnoreEvent;
+    procedure SetCanIgnore(const Value: TJvSpellCheckIgnoreEvent);
+    property OnCanIgnore: TJvSpellCheckIgnoreEvent read GetCanIgnore write SetCanIgnore;
+  end;
+
+var
+  CreateSpellChecker: function: IJvSpellChecker = nil;
+
+{$IFDEF UNITVERSIONING}
+const
+  UnitVersioning: TUnitVersionInfo = (
+    RCSfile: '$URL$';
+    Revision: '$Revision$';
+    Date: '$Date$';
+    LogPath: 'JVCL\run'
+  );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+
+{$IFDEF UNITVERSIONING}
+initialization
+  RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+  UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.

components/jvcllaz/run/JvCmp/JvSpellerForm.lfm

@@ -0,0 +1,114 @@
+object JvSpellerForm: TJvSpellerForm
+  Left = 306
+  Top = 251
+  BorderStyle = bsDialog
+  Caption = 'Spelling checker'
+  ClientHeight = 153
+  ClientWidth = 371
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = False
+  PixelsPerInch = 96
+  TextHeight = 13
+  object LblContext: TLabel
+    Left = 0
+    Top = 33
+    Width = 371
+    Height = 86
+    Hint = 'look ahead box'
+    Align = alClient
+    Caption = 'LblContext'
+    ParentShowHint = False
+    ShowHint = True
+    WordWrap = True
+  end
+  object TextPanel: TPanel
+    Left = 0
+    Top = 0
+    Width = 371
+    Height = 33
+    Align = alTop
+    BevelInner = bvRaised
+    BevelOuter = bvLowered
+    TabOrder = 0
+    object TxtSpell: TEdit
+      Left = 7
+      Top = 7
+      Width = 293
+      Height = 21
+      TabOrder = 0
+      Text = 'TxtSpell'
+    end
+  end
+  object ButtonPanel: TPanel
+    Left = 0
+    Top = 119
+    Width = 371
+    Height = 34
+    Align = alBottom
+    BevelInner = bvRaised
+    BevelOuter = bvLowered
+    TabOrder = 1
+    object BtnSkip: TButton
+      Left = 13
+      Top = 7
+      Width = 61
+      Height = 20
+      Hint = 'Skip this word'
+      Caption = '&Skip'
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 0
+    end
+    object BtnChange: TButton
+      Left = 228
+      Top = 7
+      Width = 60
+      Height = 20
+      Hint = 'Change to corrected word'
+      Caption = '&Change'
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 3
+    end
+    object BtnCancel: TButton
+      Left = 299
+      Top = 7
+      Width = 61
+      Height = 20
+      Hint = 'Abort all changes'
+      Caption = 'Cancel'
+      ModalResult = 2
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 4
+    end
+    object BtnAdd: TButton
+      Left = 156
+      Top = 7
+      Width = 61
+      Height = 20
+      Hint = 'Add to user Dictionary'
+      Caption = '&Add'
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 2
+    end
+    object BtnSkipAll: TButton
+      Left = 85
+      Top = 7
+      Width = 60
+      Height = 20
+      Hint = 'Skip all, update and finish'
+      Caption = 'S&kip All'
+      ModalResult = 1
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 1
+    end
+  end
+end

components/jvcllaz/run/JvCmp/JvSpellerForm.pas

@@ -0,0 +1,433 @@
+{-----------------------------------------------------------------------------
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/MPL-1.1.html
+
+Software distributed under the License is distributed on an "AS IS" basis,
+WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
+the specific language governing rights and limitations under the License.
+
+The Original Code is: JvSpellerForm.PAS, released on 2002-06-15.
+
+The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]
+Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven.
+All Rights Reserved.
+
+Contributor(s): Robert Love [rlove att slcdug dott org].
+
+You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
+located at http://jvcl.delphi-jedi.org
+
+Known Issues:
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvSpellerForm;
+
+{$mode objfpc}{$H+}
+//{$I jvcl.inc}
+
+interface
+
+uses
+  SysUtils, Classes, Windows, Messages, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, ExtCtrls,
+  JvComponent;
+
+type
+  TJvSpeller = class;
+
+  TJvSpellerForm = class(TForm) //TJvForm)
+    TextPanel: TPanel;
+    LblContext: TLabel;
+    TxtSpell: TEdit;
+    ButtonPanel: TPanel;
+    BtnSkip: TButton;
+    BtnChange: TButton;
+    BtnCancel: TButton;
+    BtnAdd: TButton;
+    BtnSkipAll: TButton;
+  private
+    FSpeller: TJvSpeller;
+  end;
+
+  TJvDicIndexArray = array [1..26] of Integer;
+
+  TJvSpeller = class(TComponent)
+  private
+    FSourceText: string;
+    FDict: string;
+    FUserDic: string;
+    FUserDicChanged: Boolean;
+    FDicIndex: TJvDicIndexArray;
+    FUserDicIndex: TJvDicIndexArray;
+    FSpellerDialog: TJvSpellerForm;
+    FWordBegin: Integer;
+    FWordEnd: Integer;
+    FDictionary: TFileName;
+    FUserDictionary: TFileName;
+    function WordBegin: Boolean;
+    function WordEnd: Boolean;
+    function ParseWord: string;
+    procedure SpellNext;
+    procedure Skip(Sender: TObject);
+    procedure Add(Sender: TObject);
+    procedure Change(Sender: TObject);
+    procedure IndexDictionary;
+    procedure IndexUserDictionary;
+    procedure SetDictionary(const Value: TFileName);
+    procedure SetUserDictionary(const Value: TFileName);
+    procedure CreateSpellerDialog(const SpellWord: string);
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure LoadDictionary(const AFile: string);
+    procedure LoadUserDictionary(const AFile: string);
+    procedure Spell(var SourceText: string);
+  published
+    property Dictionary: TFileName read FDictionary write SetDictionary;
+    property UserDictionary: TFileName read FUserDictionary write SetUserDictionary;
+  end;
+
+{$IFDEF UNITVERSIONING}
+const
+  UnitVersioning: TUnitVersionInfo = (
+    RCSfile: '$URL$';
+    Revision: '$Revision$';
+    Date: '$Date$';
+    LogPath: 'JVCL\run'
+  );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+uses
+  StrUtils,
+  {$IFNDEF COMPILER12_UP}
+  JvJCLUtils,
+  {$ENDIF ~COMPILER12_UP}
+  JvConsts, JvResources, JvTypes;
+
+{$R *.lfm}
+
+procedure SaveAnsiFileFromString(const AFile, AText: string);
+var
+  AnsiText: AnsiString;
+begin
+  AnsiText := AnsiString(AText);
+  with TFileStream.Create(AFile, fmCreate) do
+  try
+    WriteBuffer(AnsiText[1], Length(AnsiText));
+  finally
+    Free;
+  end;
+end;
+
+function LoadAnsiFileToString(const AFile: string): string;
+var
+  AnsiText: AnsiString;
+begin
+  with TFileStream.Create(AFile, fmOpenRead) do
+  try
+    SetLength(AnsiText, Size);
+    if AnsiText <> '' then
+      ReadBuffer(AnsiText[1], Size);
+  finally
+    Free;
+  end;
+  Result := string(AnsiText);
+end;
+
+//=== { TJvSpeller } =========================================================
+
+constructor TJvSpeller.Create(AOwner: TComponent);
+var
+  I: Integer;
+begin
+  inherited Create(AOwner);
+  for I := 1 to 26 do
+  begin
+    FDicIndex[I] := 1;
+    FUserDicIndex[I] := 1;
+  end;
+end;
+
+procedure TJvSpeller.Add(Sender: TObject);
+var
+  S: string;
+begin
+  S := FSpellerDialog.TxtSpell.Text;
+  if S = '' then
+    Exit;
+  FUserDic := FUserDic + LowerCase(S) + Cr;
+  FUserDicChanged := True;
+  with TStringList.Create do
+    try
+      Text := FUserDic;
+      Sort;
+      FUserDic := Text;
+    finally
+      Free;
+    end;
+  IndexUserDictionary;
+  Skip(Sender);
+end;
+
+procedure TJvSpeller.Change(Sender: TObject);
+var
+  S: string;
+begin
+  S := FSpellerDialog.TxtSpell.Text;
+  if S <> '' then
+  begin
+    FSourceText := Copy(FSourceText, 1, FWordBegin - 1) + S +
+      Copy(FSourceText, FWordEnd, Length(FSourceText));
+    FWordEnd := FWordEnd + (Length(S) - (FWordEnd - FWordBegin));
+    Skip(Sender);
+  end;
+end;
+
+procedure TJvSpeller.IndexDictionary;
+var
+  I, P, StartPos: Integer;
+begin
+  FDicIndex[1] := 1;
+  for I := 2 to 26 do
+  begin
+    if FDicIndex[I - 1] <> 1 then
+      StartPos := FDicIndex[I - 1]
+    else
+      StartPos := 1;
+    P := PosEx(Cr + Chr(96 + I), FDict, StartPos);
+    if P <> 0 then
+      FDicIndex[I] := P
+    else
+      FDicIndex[I] := FDicIndex[I - 1];
+  end;
+end;
+
+procedure TJvSpeller.IndexUserDictionary;
+var
+  I, P, StartPos: Integer;
+begin
+  FUserDicIndex[1] := 1;
+  for I := 2 to 26 do
+  begin
+    if FUserDicIndex[I - 1] <> 1 then
+      StartPos := FUserDicIndex[I - 1]
+    else
+      StartPos := 1;
+    P := PosEx(Cr + Chr(96 + I), FUserDic, StartPos);
+    if P <> 0 then
+      FUserDicIndex[I] := P
+    else
+      FUserDicIndex[I] := FUserDicIndex[I - 1];
+  end;
+end;
+
+procedure TJvSpeller.LoadDictionary(const AFile: string);
+begin
+  if FileExists(AFile) then
+    FDict := LoadAnsiFileToString(AFile)
+  else
+    FDict := '';
+  IndexDictionary;
+end;
+
+procedure TJvSpeller.LoadUserDictionary(const AFile: string);
+begin
+  UserDictionary := AFile;
+  FUserDicChanged := False;
+  if FileExists(AFile) then
+    FUserDic := LoadAnsiFileToString(AFile)
+  else
+    FUserDic := '';
+  IndexUserDictionary;
+end;
+
+function TJvSpeller.ParseWord: string;
+begin
+  if WordBegin and WordEnd then
+    Result := Copy(FSourceText, FWordBegin, FWordEnd - FWordBegin)
+  else
+    Result := '';
+end;
+
+procedure TJvSpeller.SetDictionary(const Value: TFileName);
+begin
+  if FDictionary <> Value then
+  begin
+    FDictionary := Value;
+    LoadDictionary(FDictionary);
+  end;
+end;
+
+procedure TJvSpeller.SetUserDictionary(const Value: TFileName);
+begin
+  if FUserDictionary <> Value then
+  begin
+    FUserDictionary := Value;
+    LoadUserDictionary(FUserDictionary);
+  end;
+end;
+
+procedure TJvSpeller.Skip(Sender: TObject);
+begin
+  FSpellerDialog.TxtSpell.Text := '';
+  SpellNext;
+end;
+
+procedure TJvSpeller.CreateSpellerDialog(const SpellWord: string);
+begin
+  FSpellerDialog := TJvSpellerForm.Create(Application);
+  with FSpellerDialog do
+  begin
+    FSpeller := Self;
+    BtnSkip.OnClick := @Skip;
+    BtnChange.OnClick := @Change;
+    BtnAdd.OnClick := @Add;
+    BtnAdd.Enabled := UserDictionary <> '';
+    TxtSpell.Text := SpellWord;
+    LblContext.Caption := Copy(FSourceText, FWordBegin, 75);
+  end;
+end;
+
+procedure TJvSpeller.Spell(var SourceText: string);
+var
+  Spw, S: string;
+  StartPos, Index: Integer;
+begin
+  if FDict = '' then
+    raise EJVCLException.CreateRes(@RsENoDictionaryLoaded);
+
+  FSourceText := SourceText;
+  FWordEnd := 1;
+
+  Spw := ParseWord;
+  while Spw <> '' do
+  begin
+    S := AnsiLowerCase(Spw);
+    Index := Ord(S[1]) - 96;
+    if (Index > 0) and (Index < 27) then
+      StartPos := FDicIndex[Index]
+    else
+      StartPos := 1;
+
+    if PosEx(S + Cr, FDict, StartPos) = 0 then
+    begin
+      if FUserDic <> '' then
+      begin
+        if (Index > 0) and (Index < 27) then
+          StartPos := FUserDicIndex[Index]
+        else
+          StartPos := 1;
+        if PosEx(S + Cr, FUserDic, StartPos) = 0 then
+        begin
+          CreateSpellerDialog(Spw);
+          try
+            if FSpellerDialog.ShowModal = mrOk then
+              SourceText := FSourceText;
+            // (rom) the user dictionary has to be saved always!
+            if FUserDicChanged then
+              if FUserDic <> '' then
+                SaveAnsiFileFromString(UserDictionary, FUserDic);
+          finally
+            FSpellerDialog.Free;
+          end;
+          Exit;
+        end
+      end
+      else
+      begin
+        CreateSpellerDialog(Spw);
+        try
+          if FSpellerDialog.ShowModal = mrOk then
+            SourceText := FSourceText;
+          // (rom) the user dictionary has to be saved always!
+          if FUserDicChanged then
+            if FUserDic <> '' then
+              SaveAnsiFileFromString(UserDictionary, FUserDic);
+        finally
+          FSpellerDialog.Free;
+        end;
+        Exit;
+      end;
+    end;
+
+    Spw := ParseWord;
+  end;
+end;
+
+procedure TJvSpeller.SpellNext;
+var
+  Spw, S: string;
+  Index, StartPos: Integer;
+begin
+  Spw := ParseWord;
+  while Spw <> '' do
+  begin
+    S := AnsiLowerCase(Spw);
+    Index := Ord(S[1]) - 96;
+    if (Index > 0) and (Index < 27) then
+      StartPos := FDicIndex[Index]
+    else
+      StartPos := 1;
+
+    if PosEx(S + Cr, FDict, StartPos) = 0 then
+    begin
+      if FUserDic <> '' then
+      begin
+        if (Index > 0) and (Index < 27) then
+          StartPos := FUserDicIndex[Index]
+        else
+          StartPos := 1;
+        if PosEx(S + Cr, FUserDic, StartPos) = 0 then
+        begin
+          FSpellerDialog.TxtSpell.Text := Spw;
+          FSpellerDialog.LblContext.Caption := Copy(FSourceText, FWordBegin, 75);
+          Exit;
+        end;
+      end
+      else
+      begin
+        FSpellerDialog.TxtSpell.Text := Spw;
+        FSpellerDialog.LblContext.Caption := Copy(FSourceText, FWordBegin, 75);
+        Exit;
+      end;
+    end;
+    Spw := ParseWord;
+  end;
+  FSpellerDialog.ModalResult := mrOk;
+end;
+
+function TJvSpeller.WordBegin: Boolean;
+var
+  L: Integer;
+begin
+  L := Length(FSourceText);
+  FWordBegin := FWordEnd;
+  while (FWordBegin <= L) and (not CharInSet(FSourceText[FWordBegin], ['a'..'z', 'A'..'Z'])) do
+    Inc(FWordBegin);
+  Result := (FWordBegin <= L);
+end;
+
+function TJvSpeller.WordEnd: Boolean;
+var
+  L: Integer;
+begin
+  FWordEnd := FWordBegin;
+  L := Length(FSourceText);
+  while (FWordEnd <= L) and CharInSet(FSourceText[FWordEnd], ['a'..'z', 'A'..'Z']) do
+    Inc(FWordEnd);
+  Result := (FWordEnd <= L);
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+  RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+  UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.