{*********************************************************

 SlavaNap source code.

 Copyright 2001,2002 by SlavaNap development team
 Released under GNU General Public License

 Latest version is available at
 http://www.slavanap.org

**********************************************************

 Unit: Keywords

 Functions to manage/search keywords list

*********************************************************}
unit Keywords;

interface

uses
  Windows, Classes2, SysUtils, STypes, Constants, SlavaStrings, Class_Cmdlist,
  Class_Cmd2List, Keywords2, Share, StringResources;

{$I Defines.pas}

procedure InitKeywords; // Should be Called before First share/Search command
procedure FreeKeywords; // Should be Called after All files Are unshared
function SplitToKeywords(Str: string; List: TNapCmdList;
  Limit: Integer): Integer;
procedure SplitToKeywordsEx(Inc_Str, Exc_Str: string;
  Inc_List, Exc_List: TNapCmdList; Limit: Integer);
function GetKeywordIndex(Keyword: string): Integer;
procedure LoadDirs;
procedure SaveDirs;
procedure FreeDirs;

var
  // Global list of keywords.
  // Sorted this Way (3-Dimentional array to search it faster):
  // 1 - type of Shared file: SHARED_Xxx Constants
  // 2 - First character of keyword
  // 3 - Length of Keyword
  DB_Keywords: array[0..SHARED_ARRAY - 1, 0..KEYWORDS_FIRST_COUNT - 1,
    KEYWORD_LEN_MIN..KEYWORD_LEN_MAX] of PKeywordList;

implementation

uses
  Vars, Handler;

procedure Split2ByteString(Str: PString); // 2バイトキーワードを変換して区切る
var
  I: Integer;
  T, Tprev: TMbcsByteType;
begin
  I := 1;
  while I <= Length(Str^) do
  begin
    T := ByteType(Str^, I);
    Tprev := ByteType(Str^, I - 1);
    if (T = mbSingleByte) and (Tprev = mbSingleByte) then
    begin
      if ((Str^[I] in [#$30..#$7A]) and (Str^[I - 1] in [#$A6..#$DF])) or
        ((Str^[I] in [#$A6..#$DF]) and (Str^[I - 1] in [#$30..#$7A])) then
      begin // 半角英数字と半角カタカナの間に区切り
        Insert('.', Str^, I);
        Inc(I);
      end
      else if ((Str^[I] in [#$30..#$39]) and (Str^[I - 1] in [#$40..#$7A])) or
        ((Str^[I] in [#$40..#$7A]) and (Str^[I - 1] in [#$30..#$39])) then
      begin // 数字とアルファベット+'@'の間に区切り
        Insert('.', Str^, I);
        Inc(I);
      end;
    end
    else if (T = mbSingleByte) and (Tprev = mbTrailByte) then
    begin
      if (Str^[I] = 'ﾞ') and (Str^[I - 2] = #$82) and (StrScan(HIRAGANA_D, Str^[I
        - 1]) <> nil) then
      begin // 濁音になれる全角ひらがな+'ﾞ'を濁音に変換
        Inc(Str^[I - 1]);
        Delete(Str^, I, 1);
        Dec(I);
      end
      else if (Str^[I] = 'ﾟ') and (Str^[I - 2] = #$82) and (StrScan(HIRAGANA_H,
        Str^[I - 1]) <> nil) then
      begin // 半濁音になれる全角ひらがな+'ﾟ'を半濁音に変換
        Inc(Str^[I - 1], 2);
        Delete(Str^, I, 1);
        Dec(I);
      end
      else
      begin // 全角文字と半角文字の間に区切り
        Insert('.', Str^, I);
        Inc(I);
      end;
    end
    else if T = mbLeadByte then
    begin
      if (Str^[I] = #$81) and (Str^[I + 1] in [#$40..#$49, #$4C..#$51,
        #$5C..#$FC]) then
      begin // 全角記号→区切り(例外:゛゜ヽヾゝゞ〃仝々〆〇ー)
        Delete(Str^, I, 2);
        Insert('.', Str^, I);
      end
      else if (Str^[I] = #$81) and (Str^[I + 1] in [#$4A, #$4B, #$5B]) then
      begin // ゛゜ーを半角にする
        if Str^[I + 1] = #$4A then
          Str^[I + 1] := #$DE
        else if Str^[I + 1] = #$4B then
          Str^[I + 1] := #$DF
        else if Str^[I + 1] = #$5B then
          Str^[I + 1] := #$B0;
        Delete(Str^, I, 1);
        Dec(I);
      end
      else if (Str^[I] = #$82) and (Str^[I + 1] in [#$4F..#$58, #$60..#$79,
        #$81..#$9A]) then
      begin // 全角英数字を半角にする
        Str^[I + 1] := EISUUJI[Ord(Str^[I + 1]) - $4F + 1];
        Delete(Str^, I, 1);
        Dec(I);
      end
      else if (Str^[I] = #$83) and (Str^[I + 1] in [#$40..#$96]) then
      begin // 全角カタカナを半角にする
        Str^[I] := KATAKANA[(Ord(Str^[I + 1]) - $40) * 2 + 1];
        Str^[I + 1] := KATAKANA[(Ord(Str^[I + 1]) - $40) * 2 + 2];
        if Str^[I] = ' ' then
          Delete(Str^, I, 1);
        Dec(I);
      end
      else if (Tprev = mbSingleByte) and (I > 1) and (Str^[I - 1] <> ' ') and
        (Str^[I - 1] <> '-') then
      begin // 半角文字(空白・'-'以外)と全角文字の間に区切り
        Insert('.', Str^, I);
        Inc(I);
      end
      else if Tprev = mbTrailByte then
      begin
        if ((Str^[I] >= #$88) and (Str^[I - 2] < #$88)) or
          ((Str^[I] < #$88) and (Str^[I - 2] >= #$88)) then
        begin // 漢字とそれ以外の全角文字の間に区切り
          Insert('.', Str^, I);
          Inc(I);
        end
        else if ((Str^[I] = #$8F) and (Str^[I + 1] = #$97) and (Str^[I + 2] =
          #$8E) and (Str^[I + 3] = #$71)) or // '女子'
        ((Str^[I] = #$8F) and (Str^[I + 1] = #$AC) and (Str^[I + 2] = #$8A) and
          (Str^[I + 3] = #$77)) or // '小学'
        ((Str^[I] = #$92) and (Str^[I + 1] = #$86) and (Str^[I + 2] = #$8A) and
          (Str^[I + 3] = #$77)) or // '中学'
        ((Str^[I] = #$93) and (Str^[I + 1] = #$90) and (Str^[I + 2] = #$8E) and
          (Str^[I + 3] = #$42)) then // '盗撮'
        begin // 特定の漢字の直前に区切り
          Insert('.', Str^, I);
          Inc(I, 4);
        end;
      end;
    end
    else if T = mbTrailByte then
    begin
      if ((Str^[I - 1] = #$8D) and (Str^[I] = #$CB)) or // '才'
      ((Str^[I - 1] = #$8D) and (Str^[I] = #$CE)) or // '歳'
      ((Str^[I - 3] = #$8D) and (Str^[I - 2] = #$82) and (Str^[I - 1] = #$90)
        and (Str^[I] = #$B6)) or // '高生'
      ((Str^[I - 3] = #$8A) and (Str^[I - 2] = #$77) and (Str^[I - 1] = #$90)
        and (Str^[I] = #$B6)) then // '学生'
      begin // 特定の漢字の直後に区切り
        Insert('.', Str^, I + 1);
        Inc(I);
      end
    end;
    Inc(I);
  end;
end;

function SplitToKeywords(Str: string; List: TNapCmdList;
  Limit: Integer): Integer;
var
  I, Start, Count, Crc: Integer;
  Spacing: Boolean;
  C: Char;
  Item: string;
begin // Extract up to $limit keywords from string and add it to list with CRC
  // Before calling this function you should add ' ' at the end of string or you might loose your last keyword
  Tmp_Pos := 12262;
  Split2ByteString(@Str);
  Tmp_Pos := 1280;
  Result := 0;
  Start := 0;
  if Block_Weird_XnapFile and (AnsiPos('?', Str) <> 0) then Exit;
  Spacing := True;
  for I := 1 to Length(Str) do
  begin
    C := Str[I];
    if Spacing then
    begin // Searching for Beginning of Keyword
      //     if Pos(C, KEYWORDS_FIRST) > 0 then // Found our First keyword Character
      if Pos(C, KEYWORDS_SEPARATORS) = 0 then
        // Found our First keyword Character
      begin
        Start := I;
        Spacing := False;
      end;
    end
    else
    begin // Searching for end of Keyword
      if Pos(C, KEYWORDS_SEPARATORS) > 0 then // Found Spacing
        if ByteType(Str, I) = mbSingleByte then
        begin
          Spacing := True;
          Count := I - Start;
          if Count >= KEYWORD_LEN_MIN then
          begin
            if Count > KEYWORD_LEN_MAX then
              Count := KEYWORD_LEN_MAX;
            Item := Copy(Str, Start, Count);
            Crc := StringCRC(Item, False);
            if List.FindItem(Crc, Item) = -1 then
            begin
              List.AddCmd(Crc, Item);
              Inc(Result);
              if Result >= Limit then Exit;
            end;
          end;
        end;
    end;
  end;
  Tmp_Pos := 1281;
end;

procedure SplitToKeywordsEx(Inc_Str, Exc_Str: string;
  Inc_List, Exc_List: TNapCmdList; Limit: Integer);
var
  I, J, Start, Count, Crc: Integer;
  Spacing, HardSpacing, Excluding, Last_Exc: Boolean;
  C: Char;
  Item: string;
begin // Extract up to $Limit keywords From string and add It to List with CRC
  // Before calling This function You should Add ' ' At the end of string or You might Loose your Last keyword
  Tmp_Pos := 12262;
  Split2byteString(@Inc_Str);
  Split2byteString(@Exc_Str);
  Tmp_Pos := 1280;
  Start := 0;
  Spacing := True;
  HardSpacing := True;
  Excluding := False;
  Last_Exc := False;
  for I := 1 to Length(Inc_Str) do
  begin
    C := Inc_Str[I];
    if Spacing then
    begin // Searching for Beginning of Keyword
      //     if Pos(C, KEYWORDS_FIRST) > 0 then // Found our First keyword Character
      if Pos(C, KEYWORDS_SEPARATORS) = 0 then
        // Found our First keyword Character
      begin
        Start := I;
        Spacing := False;
        HardSpacing := False;
        Excluding := Last_Exc;
        Last_Exc := False;
      end
      else
      begin
        if (C = '-') and HardSpacing and (ByteType(Inc_Str, I) = mbSingleByte)
          then
          Last_Exc := True
        else
          Last_Exc := False;
        if (C = #$20) and (ByteType(Inc_Str, I) = mbSingleByte) then
          HardSpacing := True
        else
          HardSpacing := False;
      end;
    end
    else
    begin // Searching for end of Keyword
      Last_Exc := False;
      HardSpacing := False;
      if Pos(C, KEYWORDS_SEPARATORS) > 0 then // Found Spacing
        if ByteType(Inc_Str, I) = mbSingleByte then
        begin
          Spacing := True;
          if (C = #$20) and (ByteType(Inc_Str, I) = mbSingleByte) then
            HardSpacing := True;
          Count := I - Start;
          if Count >= KEYWORD_LEN_MIN then
          begin
            if Count > KEYWORD_LEN_MAX then
              Count := KEYWORD_LEN_MAX;
            Item := Copy(Inc_Str, Start, Count);
            Crc := StringCRC(Item, False);
            if Excluding then
            begin
              if Exc_List.FindItem(Crc, Item) = -1 then
                Exc_List.AddCmd(Crc, Item);
              J := Inc_List.FindItem(Crc, Item);
              if J <> -1 then
                Inc_List.Delete(J);
              if not HardSpacing then
                Last_Exc := True;
            end
            else
            begin
              if (Inc_List.FindItem(Crc, Item) = -1) and (Inc_List.Count < Limit)
                then
                Inc_List.AddCmd(Crc, Item);
              J := Exc_List.FindItem(Crc, Item);
              if J <> -1 then
                Exc_List.Delete(J);
            end;
          end;
        end;
    end;
  end;
  Spacing := True;
  // HardSpacing := False;
  for I := 1 to Length(Exc_Str) do
  begin
    C := Exc_Str[I];
    if Spacing then
    begin // Searching for Beginning of Keyword
      //     if Pos(C, KEYWORDS_FIRST) > 0 then // Found our First keyword Character
      if Pos(C, KEYWORDS_SEPARATORS) = 0 then
        // Found our First keyword Character
      begin
        Start := I;
        Spacing := False;
      end;
    end
    else
    begin // Searching for end of Keyword
      if Pos(C, KEYWORDS_SEPARATORS) > 0 then // Found Spacing
        if ByteType(Exc_Str, I) = mbSingleByte then
        begin
          Spacing := True;
          Count := I - Start;
          if Count >= KEYWORD_LEN_MIN then
          begin
            if Count > KEYWORD_LEN_MAX then
              Count := KEYWORD_LEN_MAX;
            Item := Copy(Exc_Str, Start, Count);
            Crc := StringCRC(Item, False);
            if Exc_List.FindItem(Crc, Item) = -1 then
            begin
              Exc_List.AddCmd(Crc, Item);
            end;
            J := Inc_List.FindItem(Crc, Item);
            if J <> -1 then
              Inc_List.Delete(J);
          end;
        end;
    end;
  end;
  Tmp_Pos := 1281;
end;

function GetKeywordIndex(Keyword: string): Integer;
// Returns index of keyword or -1 if keyword Is invalid
begin
  if Length(Keyword) < 1 then
    Result := KEYWORDS_NOINDEX
  else if Pos(Keyword[1], KEYWORDS_FIRST) = 0 then
    Result := KEYWORDS_FIRST_COUNT - 1 // 2byte Char
  else
    Result := Pos(Keyword[1], KEYWORDS_FIRST) - 1;
end;

procedure InitKeywords;
var
  I, J, K: Integer;
begin
  for I := 0 to SHARED_ARRAY - 1 do
    for J := 0 to KEYWORDS_FIRST_COUNT - 1 do
      for K := KEYWORD_LEN_MIN to KEYWORD_LEN_MAX do
        DB_Keywords[I, J, K] := KWList_CreateList;
end;

procedure FreeKeywords;
var
  I, J, K: Integer;
  ATime: Integer;
begin
  ATime := GetTickCount;
  for I := 0 to SHARED_ARRAY - 1 do
    for J := 0 to KEYWORDS_FIRST_COUNT - 1 do
      for K := KEYWORD_LEN_MIN to KEYWORD_LEN_MAX do
      begin
        KWList_FreeList(DB_Keywords[I, J, K]);
        DB_Keywords[I, J, K] := nil;
      end;
  DebugLog('Raptime of FreeKeywords=' + IntToStr(GetTickCount - ATime), True);
end;

procedure LoadDirs;
var
  List: TMyStringList;
  I: Integer;
  Str: string;
begin
  if DB_Dirs <> nil then
    DB_Dirs.Clear
  else
    DB_Dirs := TNapCmdList.Create;
  List := TMyStringList.Create;
  try
    List.LoadFromFile(ApplicationDir + 'dirs');
  except
  end;
  for I := 0 to List.Count - 1 do
    if Length(List.Strings[I]) > 1 then
      if List.Strings[I][1] <> '#' then
      begin
        Str := AnsiLowerCase(List.Strings[I]);
        DB_Dirs.AddCmd(StringCRC(Str, False), Str);
      end;
  List.Free;
end;

procedure SaveDirs;
var
  List: TMyStringList;
  I: Integer;
begin
  if DB_Dirs = nil then Exit;
  List := TMyStringList.Create;
  for I := 0 to DB_Dirs.Count - 1 do
    List.Add(PNapCmd(DB_Dirs.Items[I])^.Cmd);
  List.Sort;
  List.Insert(0, RS_Keywords_FileDiscription0);
  List.Insert(1, RS_Keywords_FileDiscription1);
  List.Insert(2, RS_Keywords_FileDiscription2);
  List.Insert(3, RS_Keywords_FileDiscription3);
  List.Insert(4, RS_Keywords_FileDiscription4);
  try
    List.SaveToFile(ApplicationDir + 'dirs');
  except
  end;
  List.Free;
end;

procedure FreeDirs;
begin
  if DB_Dirs <> nil then
    DB_Dirs.Free;
  DB_Dirs := nil;
end;

initialization
  DB_Dirs := nil;
end.
