unit IMTSearch;
{
[IMTSearch] [1.1]
Delphi 2005
April 2008


LICENSE

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/"

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is "[IMTSearch.pas]".

The Initial Developer of the Original Code is Martin Holmes (Victoria,
BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2006-2008 Martin Holmes
and the University of Victoria Computing and Media Centre. The code was
co-developed for university and personal projects, and rights are shared
by Martin Holmes and the University of Victoria. All Rights Reserved.
}

{
Written by Martin Holmes, February 2008.

This unit contains classes and routines for handling search-and-replace
functionality in an Image Markup Tool document (TIMTDoc).

It uses the TUTBMSearch (Unicode Tuned Boyer-Moore) implementation of
TSearchEngine found in the Project JEDI jclUnicode.pas library.
  
Dependencies:

JEDI JCL (Project JEDI)


}
interface

uses Windows, Messages, SysUtils, Variants, Classes, jclUnicode, WideStrUtils,
     Forms;

{Enumerated type which defines which part of the document a selection is found.}
type TContTypes = (ctNone, ctHeader, ctAnnTitle, ctAnnText, ctCatId, ctCatExplanation);

type
  TimtSelection = class

  public
    ContType: TContTypes; //type of container (document component) containing the selection.
    ItemIndex: integer; //index of the annotation or category; or 0 for a header.
    SelStart: integer; //the location of the hit
    SelLength: integer; //length of the hit
    SelText: WideString; //the original text (we may use it to do sanity checks).
    constructor Create;
    destructor Destroy; override;
    procedure CopySelf(TargetSel: TimtSelection);
  end;

type
  TimtSearchList = class(TList)
  private
    FDown: Boolean;
    USearch: TUTBMSearch;
  public
    constructor Create;
    destructor Destroy; override;
    procedure ClearAll;
    procedure AddNewSelection(ContType: TContTypes;
                              ItemIndex, SelStart, SelLength: integer;
                              SelText: WideString);
{This searches the text of the item passed to it, and adds a
 TimtSelection record to the list for every hit found. If DoReplace is true, it replaces
 the hit with the replacement string, and records the length of the replacement
 string instead of the hit length in the relevant selection record.
 It returns the total number of replacement operations done.}
    function SearchContainer(ContType: TContTypes; ItemIndex: integer;
                             MatchCase, WholeWordOnly: Boolean;
                             SearchFor, SearchIn: WideString;
                             ReplaceWith: WideString; DoReplace: Boolean;
                             var ResultString: WideString): integer;
  published
    property Down: Boolean read FDown write FDown default True;
  end;

  function getSuccContainerType(thisContType: TContTypes; WrapAround: Boolean): TContTypes;
  function getPrevContainerType(thisContType: TContTypes; WrapAround: Boolean): TContTypes;
  function getNextContainerType(thisContType: TContTypes; WrapAround: Boolean;
                                Down: Boolean): TContTypes;
implementation

{ TimtSelection }

procedure TimtSelection.CopySelf(TargetSel: TimtSelection);
begin
  TargetSel.ContType := ContType;
  TargetSel.ItemIndex := ItemIndex;
  TargetSel.SelStart := SelStart;
  TargetSel.SelLength := SelLength;
  TargetSel.SelText := SelText;
end;

constructor TimtSelection.Create;
begin
  inherited;
//initialize safety values
  ContType := ctNone;
  ItemIndex := -1;
  SelStart := -1;
  SelLength := -1;
  SelText := '';
end;

destructor TimtSelection.Destroy;
begin
//Nothing to do here, as yet.
  inherited;
end;

{ TimtSelList }

procedure TimtSearchList.AddNewSelection(ContType: TContTypes; ItemIndex,
  SelStart, SelLength: integer; SelText: WideString);
var
imtSel: TimtSelection;

begin
  imtSel := TimtSelection.Create;
  imtSel.ContType := ContType;
  imtSel.ItemIndex := ItemIndex;
  imtSel.SelStart := SelStart;
  imtSel.SelLength := SelLength;
  imtSel.SelText := SelText;
  if FDown then
    Add(imtSel)
  else
    Insert(0, imtSel);
end;

procedure TimtSearchList.ClearAll;
var
i: integer;

begin
  if Count > 0 then
    for i := Count-1 downto 0 do
      FreeAndNil(TimtSelection(List[i]));
  Clear;
  FDown := True;
end;

constructor TimtSearchList.Create;
begin
  USearch := TUTBMSearch.Create(nil);
  FDown := True;
end;

destructor TimtSearchList.Destroy;

begin
  ClearAll;
  FreeAndNil(USearch);
  inherited;
end;

function TimtSearchList.SearchContainer(ContType: TContTypes; ItemIndex: integer;
                                        MatchCase, WholeWordOnly: Boolean;
                                        SearchFor, SearchIn: WideString;
                                        ReplaceWith: WideString; DoReplace: Boolean;
                                        var ResultString: WideString): integer;

var
Flags: TSearchFlags;
PrepSearchFor, PrepSearchIn: WideString;
i, j, Start, Stop, Len, Change: integer;
imtSel: TimtSelection;
Pref, Suff: WideString;
listTemp: TList;
FoundStuff: Boolean;

begin
  Result := 0; //default, meaning no hits found
  ResultString := SearchIn; //default, meaning no replacements or changes.
  USearch.Clear;

  if WholeWordOnly then
    Flags := [sfWholeWordOnly]
  else
    Flags := [];
  if MatchCase then
    begin
      PrepSearchFor := SearchFor;
      PrepSearchIn := SearchIn;
    end
  else
    begin
      PrepSearchFor := WideUpperCase(SearchFor);
      PrepSearchIn := WideUpperCase(SearchIn);
    end;
  USearch.FindPrepare(PrepSearchFor, Flags);
  FoundStuff := USearch.FindAll(PrepSearchIn);
  if FoundStuff then
    begin
      if DoReplace then
        begin
//WideShowMessage(ResultString);
//Create the temporary list (we need this because we must process in
//reverse order, whatever the Down setting is, so that replacements
//don't invalidate subsequent hits).
          listTemp := TList.Create;
          try
//Work downwards through the hits
            for i := USearch.Count-1 downto 0 do
              begin
//First, change the result string
                USearch.GetResult(i, Start, Stop);
                Pref := Copy(ResultString, 1, Start);
                Suff := Copy(ResultString, Stop+1, Length(ResultString) - Stop);
                Len := Stop-(Start-1);
                ResultString :=  Pref + ReplaceWith + Suff;
                Change := Length(ReplaceWith) - Len;

//Now create a new selection and store it in the list
                imtSel := TimtSelection.Create;
                imtSel.ContType := ContType;
                imtSel.ItemIndex := ItemIndex;
                imtSel.SelStart := Start;
                imtSel.SelLength := Length(ReplaceWith);
                imtSel.SelText := ReplaceWith;
                listTemp.Add(imtSel);

                Application.ProcessMessages;

//Now we have to massage any subsequent selections to take account of
//changes in the string length caused by this replacement.
                if listTemp.Count > 1 then
                  for j := listTemp.Count-2 downto 0 do
                    TimtSelection(listTemp[j]).SelStart :=
                            TimtSelection(listTemp[j]).SelStart + Change;
                inc(Result); //One replacement done.
                Application.ProcessMessages;
              end;
//Now go through the  temp list in the order required by Down, and add or insert
//our selections in the master list.
            for i := listTemp.Count-1 downto 0 do
              if Down then
                Add(listTemp[i])
              else
                Insert(0, listTemp[i]);
            Application.ProcessMessages;
          finally
            FreeAndNil(listTemp);
          end;
//WideShowMessage(ResultString);
        end
      else
        begin
//This is way simpler; we can just hand off each result to the AddNewSelection function.
          for i := 0 to USearch.Count-1 do
            begin
              USearch.GetResult(i, Start, Stop);
              Len := Stop-Start;
              AddNewSelection(ContType, ItemIndex, Start, Len,
                              Copy(SearchIn, Start+1, Len));
            end;
        end;
    end;
end;


function getSuccContainerType(thisContType: TContTypes; WrapAround: Boolean): TContTypes;
var
ContType: TContTypes;

begin
  if thisContType < High(ContType) then
    Result := Succ(thisContType)
  else
    if WrapAround then
      Result := Succ(ctNone) //ctNone is in 0th pos; ignore that
    else
      Result := ctNone;
end;

function getPrevContainerType(thisContType: TContTypes; WrapAround: Boolean): TContTypes;
var
ContType: TContTypes;

begin
  if thisContType > Succ(ctNone) then
    Result := Pred(thisContType)
  else
    if WrapAround then
      Result := High(ContType) //ctNone is in 0th pos; ignore that
    else
      Result := ctNone;
end;

function getNextContainerType(thisContType: TContTypes; WrapAround: Boolean;
                                Down: Boolean): TContTypes;
begin
  if Down then
    Result := getSuccContainerType(thisContType, WrapAround)
  else
    Result := getPrevContainerType(thisContType, WrapAround);
end;

end.