1unit SpellCheck; 2 3{ Simple unit to simplify/OOP-ize pascal-style the aspell interface. Currently 4 very limited, will be expanded eventually. Use like you wish. } 5 6{$mode objfpc}{$H+} 7 8interface 9 10uses 11 SysUtils, Classes, Aspell; 12 13type 14 TSuggestionArray = array of string; 15 16 TWordError = record 17 Word: string; // the word itself 18 Pos: LongWord; // word position in line 19 Length: LongWord; // word length 20 Suggestions: TSuggestionArray; // suggestions for the given word 21 end; 22 23 TLineErrors = array of TWordError; 24 TLineErrorsArray = array of TLineErrors; 25 26 { TSpellCheck } 27 28 TSpeller = class // abstract class, basis for all checkers 29 protected 30 FMode: string; 31 FEncoding: string; 32 FLanguage: string; 33 procedure SetEncoding(const AValue: string); 34 procedure SetLanguage(const AValue: string); 35 procedure SetMode(const AValue: string); 36 procedure CreateSpeller; virtual; abstract; 37 procedure FreeSpeller; virtual; abstract; 38 public 39 constructor Create; 40 destructor Destroy; override; 41 public 42 property Mode: string read FMode write SetMode; 43 property Encoding: string read FEncoding write SetEncoding; 44 property Language: string read FLanguage write SetLanguage; 45 end; 46 47 { TWordSpeller } 48 49 TWordSpeller = class(TSpeller) // class for simple per-word checking 50 private 51 FSpeller: PAspellSpeller; 52 FLastError: string; 53 function DoCreateSpeller(Lang, Enc, aMode: pChar): PAspellSpeller; 54 protected 55 procedure CreateSpeller; override; 56 procedure FreeSpeller; override; 57 public 58 function SpellCheck(const Word: string): TSuggestionArray; // use to check single words, parsed out by you 59 end; 60 61 { TDocumentSpeller } 62 63 TDocumentSpeller = class(TWordSpeller) 64 private 65 FChecker: PAspellDocumentChecker; 66 FLineErrors: TLineErrorsArray; 67 FNameSuggestions: Boolean; 68 function GetLineErrors(i: Integer): TLineErrors; 69 function GetLineErrorsCount: Integer; 70 protected 71 procedure CreateSpeller; override; 72 procedure FreeSpeller; override; 73 procedure DoNameSuggestions(const Word: string; var aWordError: TWordError); 74 public 75 constructor Create; 76 function CheckLine(const aLine: string): TLineErrors; 77 function CheckDocument(const FileName: string): Integer; // returns number of spelling errors found or -1 for error 78 function CheckDocument(aStringList: TStringList): Integer; // returns number of spelling errors found or -1 for error 79 procedure Reset; 80 public 81 property LineErrors[i: Integer]: TLineErrors read GetLineErrors; 82 property LineErrorsCount: Integer read GetLineErrorsCount; 83 property NameSuggestions: Boolean read FNameSuggestions write FNameSuggestions; 84 end; 85 86implementation 87 88const 89 DEFAULT_ENCODING = 'utf-8'; 90 DEFAULT_LANGUAGE = 'en'; 91 DEFAULT_MODE = ''; 92 93function GetDefaultLanguage: string; 94begin 95 Result := GetEnvironmentVariable('LANG'); 96 if Length(Result) = 0 then 97 Result := DEFAULT_LANGUAGE; 98end; 99 100{ TSpeller } 101 102procedure TSpeller.SetEncoding(const AValue: string); 103begin 104 FEncoding := aValue; 105 CreateSpeller; 106end; 107 108procedure TSpeller.SetLanguage(const AValue: string); 109begin 110 FLanguage := aValue; 111 CreateSpeller; 112end; 113 114procedure TSpeller.SetMode(const AValue: string); 115begin 116 FMode := aValue; 117 CreateSpeller; 118end; 119 120constructor TSpeller.Create; 121begin 122 FEncoding := DEFAULT_ENCODING; 123 FLanguage := GetDefaultLanguage; 124 FMode := DEFAULT_MODE; 125 126 CreateSpeller; 127end; 128 129destructor TSpeller.Destroy; 130begin 131 FreeSpeller; 132end; 133 134{ TWordSpeller } 135 136function TWordSpeller.DoCreateSpeller(Lang, Enc, aMode: pChar): PAspellSpeller; 137var 138 Error: Paspellcanhaveerror; 139begin 140 Result := new_aspell_config(); 141 142 if Length(FLanguage) > 0 then 143 aspell_config_replace(Result, 'lang', Lang); 144 if Length(FEncoding) > 0 then 145 aspell_config_replace(Result, 'encoding', Enc); 146 if Length(FMode) > 0 then 147 aspell_config_replace(Result, 'mode', aMode); 148 149 Error := new_aspell_speller(Result); 150 151 delete_aspell_config(Result); 152 153 if aspell_error_number(Error) <> 0 then begin 154 FLastError := aspell_error_message(Error); 155 delete_aspell_can_have_error(Error); 156 Result := nil; 157 end else 158 Result := to_aspell_speller(Error); 159end; 160 161procedure TWordSpeller.CreateSpeller; 162begin 163 FLastError := ''; 164 FreeSpeller; 165 166 FSpeller := DoCreateSpeller(pChar(FLanguage), pChar(FEncoding), pChar(FMode)); 167 if not Assigned(FSpeller) then 168 FSpeller := DoCreateSpeller(nil, pChar(FEncoding), pChar(FMode)); 169 if not Assigned(FSpeller) then 170 FSpeller := DoCreateSpeller(nil, pChar(FEncoding), nil); 171 if not Assigned(FSpeller) then 172 FSpeller := DoCreateSpeller(nil, nil, pChar(FMode)); 173 if not Assigned(FSpeller) then 174 FSpeller := DoCreateSpeller(nil, nil, nil); 175 176 if not Assigned(FSpeller) then 177 raise Exception.Create('Error on speller creation: ' + FLastError); 178end; 179 180procedure TWordSpeller.FreeSpeller; 181begin 182 if Assigned(FSpeller) then begin 183 delete_aspell_speller(FSpeller); 184 FSpeller := nil; 185 end; 186end; 187 188function TWordSpeller.SpellCheck(const Word: string): TSuggestionArray; 189var 190 sgs: Paspellwordlist; 191 elm: Paspellstringenumeration; 192 tmp: pChar; 193 i: Integer = 0; 194begin 195 SetLength(Result, 0); 196 197 if aspell_speller_check(FSpeller, pChar(Word), Length(Word)) = 0 then begin 198 sgs := aspell_speller_suggest(FSpeller, pChar(Word), Length(Word)); 199 elm := aspell_word_list_elements(sgs); 200 201 repeat 202 if i >= Length(Result) then 203 SetLength(Result, Length(Result) + 10); 204 205 tmp := aspell_string_enumeration_next(elm); 206 207 if tmp <> nil then begin 208 Result[i] := tmp; 209 Inc(i); 210 end; 211 until tmp = nil; 212 213 SetLength(Result, i); 214 215 delete_aspell_string_enumeration(elm); 216 end; 217end; 218 219{ TDocumentSpeller } 220 221function TDocumentSpeller.GetLineErrors(i: Integer): TLineErrors; 222begin 223 Result := FLineErrors[i]; 224end; 225 226function TDocumentSpeller.GetLineErrorsCount: Integer; 227begin 228 Result := Length(FLineErrors); 229end; 230 231procedure TDocumentSpeller.CreateSpeller; 232var 233 Error: PAspellCanHaveError; 234begin 235 inherited CreateSpeller; 236 237 Error := new_aspell_document_checker(FSpeller); 238 239 if aspell_error_number(Error) <> 0 then 240 raise Exception.Create('Error on checker creation: ' + aspell_error_message(Error)) 241 else 242 FChecker := to_aspell_document_checker(Error); 243end; 244 245procedure TDocumentSpeller.FreeSpeller; 246begin 247 if Assigned(FChecker) then begin 248 delete_aspell_document_checker(FChecker); 249 FChecker := nil; 250 end; 251 252 inherited FreeSpeller; 253end; 254 255procedure TDocumentSpeller.DoNameSuggestions(const Word: string; 256 var aWordError: TWordError); 257begin 258 aWordError.Suggestions := SpellCheck(Word); 259end; 260 261constructor TDocumentSpeller.Create; 262begin 263 inherited Create; 264 265 FNameSuggestions := True; 266end; 267 268function TDocumentSpeller.CheckLine(const aLine: string): TLineErrors; 269const 270 CHUNK_SIZE = 10; 271var 272 i, Count: Integer; 273 Token: AspellToken; 274begin 275 aspell_document_checker_process(FChecker, pChar(aLine), Length(aLine)); 276 277 SetLength(Result, CHUNK_SIZE); 278 i := 0; 279 Count := 0; 280 repeat 281 Token := aspell_document_checker_next_misspelling(FChecker); 282 283 if Token.len > 0 then begin 284 if Length(Result) <= i then 285 SetLength(Result, Length(Result) + CHUNK_SIZE); 286 287 Result[i].Word := Copy(aLine, Token.offset + 1, Token.len); 288 Result[i].Pos := Token.offset + 1; // C goes from 0, we go from 1 289 Result[i].Length := Token.len; 290 291 if FNameSuggestions then 292 DoNameSuggestions(Copy(aLine, Token.offset + 1, Token.len), Result[i]); 293 294 Inc(Count); 295 end; 296 297 Inc(i); 298 until Token.len = 0; 299 300 SetLength(Result, Count); 301end; 302 303function TDocumentSpeller.CheckDocument(const FileName: string): Integer; 304var 305 s: TStringList; 306begin 307 Result := 0; 308 if FileExists(FileName) then try 309 s := TStringList.Create; 310 s.LoadFromFile(FileName); 311 Result := CheckDocument(s); 312 finally 313 s.Free; 314 end; 315end; 316 317function TDocumentSpeller.CheckDocument(aStringList: TStringList): Integer; 318var 319 i: Integer; 320begin 321 Result := 0; 322 SetLength(FLineErrors, aStringList.Count); 323 324 for i := 0 to aStringList.Count - 1 do begin 325 FLineErrors[i] := CheckLine(aStringList[i]); 326 Inc(Result, Length(FLineErrors[i])); 327 end; 328end; 329 330procedure TDocumentSpeller.Reset; 331begin 332 aspell_document_checker_reset(FChecker); 333end; 334 335end. 336 337