unit IMTDocument;
{
[IMTDocument] [1.3]
Delphi 2005
December 2007


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 "[IMTDocument.pas]".

The Initial Developer of the Original Code is Martin Holmes (Victoria,
BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2006-2007 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, Winter 2006 - Fall 2007.

This unit contains classes for handling a combined TEI document which
has a list of annotations and categories into which they are classified. The
main class is TIMTDoc (IMT meaning "Image Markup Tool"), and this document has
these three major objects:

  TAnnCatList: A list of TAnnotationCategory objects. AnnotationCategories
  are used for classifying annotations into groups, and for displaying the
  groups in different visual formats to distinguish them.

  TIMTAnnList: A list of annotation objects, each consisting of a head tag and
  a div tag, in TEI, along with a WideString Category identifier which can
  be used to look up display information.

  TDomDocument: an XDOM TDomDocument is used for reading and writing the data
  to disk, and for storing some persistent parts of the data (such as teiHeader
  blocks).

  In addition, the class holds a pointer to a TImgView32 object, a graphical
  component from the Graphics32 library which displays the main image and also
  handles the display of the positioned annotation markers (TPositionedLayer
  objects).

  This class will interact with major GUI components such as the main form
  holding the TImgView32 component. It will serve up and stash away annotation
  data, as well as handling the mapping of annotations to categories, providing
  information on display features of the annotations. It will work with an
  Annotations browser window which will sort annotations into tabbed groups
  by Category and allow the user to find, show or hide annotation layers by
  group or individually. When an annotation is Showing, it will be represented
  by a visible TPositionedLayer on the TImgView32 component, styled
  appropriately; when it is hidden, any TPositionedLayer will be destroyed.
  
Dependencies:

XDOM_4_1 (Dieter Köhler)
TIntegerList (evgenij at vikarina / Ray Konopka)
Graphics32 (graphics32.org)

}
interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   XDOM_4_1, GR32, GR32_Image, GR32_Layers, AnnotationCategories, Annotation,
   jclUnicode, TntClasses, IMTDocGlobals, TntSysUtils, TntDialogs,
   FileFunctions, IntList, StdCtrls, VersionInfo, XMLUtilities, IMTSearch;

type
  TIMTDoc = class(TObject)
  private

    fImgView32: TImgView32;
    fModified: Boolean;
    fTEIHeaderEl: TDomElement;
    fCategoryIDs: TTntStringList;
    DomToXMLParser: TDomToXMLParser;
    XMLToDomParser: TXMLToDomParser;
    fImageFilePath: WideString;
    fProjDesc: WideString;
    fDocTitle: WideString;
    function GetModified: Boolean;
    procedure SetModified(const Value: Boolean);
    function GetwsTEIHeader: WideString;
    procedure SetwsTEIHeader(const Value: WideString);
    function GetCategoryIDList: TTntStrings;
    procedure SetImageFilePath(const Value: WideString);
    function FindEncodingDesc(CreateIfAbsent: Boolean): TDomElement;
    function FindFacsEl(CreateIfAbsent: Boolean): TDomElement; //New for 1.7
    function FindAnnWrapperDiv(CreateIfAbsent: Boolean): TDomElement;
    function CreateTeiHeader: Boolean;
    procedure ClearTagsDecl;
    procedure ClearAppInfo;
    procedure ClearFacsimile; //new for 1.7
    procedure ClearAnnDivs;
    function GetTEIHeaderEl: TDomElement;
    function GetAnnShowing(Index: integer): Boolean;
    procedure SetAnnShowing(Index: integer; const Value: Boolean);
    function GetXML: WideString;
    procedure SetProjDesc(const Value: WideString);
    procedure SetDocTitle(const Value: WideString);
    procedure ReadTitleAndProjDescFromTeiHeader;
    function GetAppInfoNode: TDomElement;

  public
    AnnCatList: TAnnCatList;
    IMTAnnList: TIMTAnnList;
    DomImpl: TDomImplementation;
    DomDoc: TDomDocument;
    SearchList: TIMTSearchList;

    constructor Create(ImgViewComponent: TImgView32);
    destructor Destroy; override;
    procedure Empty;
    procedure PartialClear(ClearDomDoc, ClearCategories, ClearAnnotations,
                               ClearLayers: Boolean);

    function AddAnnotation: integer; overload;
    function AddAnnotation(CategoryID: WideString): integer; overload;
    function DeleteAnnotation(Index: integer): Boolean;

    function CanDeleteCategory(CategoryID: WideString): Boolean;
    function DeleteCategory(CategoryID: WideString): Boolean;

    procedure ClearAnnAndCatDataFromDoc;
    function AddAnnAndCatDataToDoc(FileName: WideString): Boolean;

    procedure ScrollAnnToCenter(AnnNum: integer);

{The following procedure should first try to load a skeleton from a disk
file; if that fails, then it should be able to create a skeleton for itself. This
will enable users to create custom templates that the program can use. It will have to
be able to force the elements of structure it absolutely needs on the document, in
case users considerably modify it.}
    procedure CreateSkeletonDoc;

    function SaveToXMLFile(FileName: WideString; CopySchema: Boolean): Boolean;
    function LoadFromXMLFile(FileName: WideString): Boolean;
//disabled these: this conversion is better handled by an XSLT conversion
//done externally by the application.
//    function ExportToDocBookArticle(FileName: WideString): Boolean;
//    function ImportFromDocBookArticle(FileName: WideString): Boolean;


//These functions actually create and destroy layers on the image
     function CreatePositionedLayer(AnnIndex: integer): TPositionedLayer;
     function DestroyPositionedLayer(AnnIndex: integer): Boolean;

//This retrieves the merged state of the visible properties of all annotations, or all
//annotations in a category
     function VisibleState(CatID: WideString): TCheckBoxState;

//Handler for drawing layers on the image
     procedure LayerDrawingHandler(Sender: TObject; Buffer: TBitmap32);

//This function allows the simple updating of the properties of a category,
//and at the same time calls update on all the layers that will be affected.
     procedure SetCategoryProperties(CatNum: integer; NewShape: integer;
                        NewColor: TColor; NewExplanation: WideString;
                        NewTranscriptional: Boolean;
                        NewCatID: WideString);

     function SwapCategories(CatNum1, CatNum2: integer): Boolean;

//This function populates an integer list with all the annotations for a
//particular categoryid, and returns the total.
     function ListAnnsForCatID(IntList: TIntegerList; CatID: WideString): integer;

//This function does a search through the whole document, and returns the number
//of hits found. It populates the search list with the hits. If DoReplace is true,
//it replaces all of the hits as it finds them. If replacements cause ill-formed XML,
//it does not save that block of XML; instead, it records the number of replacements
//that have failed to be saved.
     function FindAll(SearchFor, ReplaceWith: WideString;
                      Down, MatchCase, WholeWordOnly: Boolean;
                      DoReplace: Boolean; var TotalReplacements: integer;
                      var FailedReplacements: integer): integer;
{This function, given a starting position in the document (container type,
item index for that type, and cursor offset) searches forward or backward through
the document to find the next hit, returning info representing that item.}
     function FindNext(SearchFor: WideString;
                          StartFrom: TIMTSelection;
                          MatchCase, WholeWordOnly: Boolean;
                          var FoundHit: TIMTSelection;
                          Down, Wraparound: Boolean): Boolean;
{This function, given a TIMTSelection object, retrieves a block of text
 with the object in context, for a KWIC display.}
     function GetKWICDisplay(Sel: TIMTSelection; PadChars: integer): WideString;

//This property provides access to the Showing setting of annotations areas,
//which in turn creates and destroys TPositionedLayer objects in the image's
//layers array.
     property AnnShowing[Index: integer]: Boolean read GetAnnShowing write SetAnnShowing;

  published
    property Modified: Boolean read GetModified write SetModified;
    property wsTEIHeader: WideString read GetwsTEIHeader write SetwsTEIHeader;
    property TEIHeaderEl: TDomElement read GetTEIHeaderEl;
    property CategoriesIDList: TTntStrings read GetCategoryIDList;
    property ImageFilePath: WideString read fImageFilePath write SetImageFilePath;

    property XML: WideString read GetXML;

    property DocTitle: WideString read fDocTitle write SetDocTitle;
    property ProjDesc: WideString read fProjDesc write SetProjDesc;
{This node in the teiHeader stores info about the authoring app itself,
 including version information. }
    property AppInfoNode: TDomElement read GetAppInfoNode;
  end;

implementation

{ TIMTDoc }

constructor TIMTDoc.Create(ImgViewComponent: TImgView32);
begin
  inherited Create;
  DomImpl := TDomImplementation.Create(nil);
  DomDoc := TDomDocument.Create(DomImpl);
  DomToXMLParser := TDomToXMLParser.Create(nil);
  DomToXMLParser.DOMImpl := DomImpl;
  XMLToDomParser := TXMLToDomParser.Create(nil);
  XMLToDomParser.DOMImpl := DomImpl;
  fImgView32 := ImgViewComponent;
  AnnCatList := TAnnCatList.Create;
  IMTAnnList := TIMTAnnList.Create(AnnCatList.GetTranscriptionalFromCatID);
  fCategoryIDs := TTntStringList.Create;
  SearchList := TIMTSearchList.Create;
  CreateSkeletonDoc;
end;

destructor TIMTDoc.Destroy;
begin
  FreeAndNil(SearchList);
  FreeAndNil(fCategoryIDs);
  FreeAndNil(IMTAnnList);
  FreeAndNil(AnnCatList);
  FreeAndNil(DomDoc);
  FreeAndNil(XMLToDomParser);
  FreeAndNil(DomToXMLParser);
  FreeAndNil(DomImpl);
  inherited;
end;

function TIMTDoc.GetModified: Boolean;
begin
  Result := fModified or IMTAnnList.Modified or AnnCatList.Modified;
end;

procedure TIMTDoc.SetModified(const Value: Boolean);
begin
  fModified := Value;
  if (Value = False) then
    begin
      IMTAnnList.Modified := False;
      AnnCatList.Modified := False;
    end;
end;

function TIMTDoc.LoadFromXMLFile(FileName: WideString): Boolean;
var
encodingDesc, FacsEl, AnnWrapperDiv, GraphicEl: TDomElement;
wsTemp: WideString;
i: integer;

begin
  Result := False;
  try
//Clear existing data
    Empty;

//Load the file into the domdoc
    DomDoc := XMLToDomParser.ParseFile(FileName, False);

//Find a teiHeader if there is one
    if DomDoc.GetElementsByTagName('teiHeader').Length > 0 then
      fteiHeaderEl := TDomElement(DomDoc.GetElementsByTagName('teiHeader').Item(0));

//Find an encodingDesc element if there is one
    encodingDesc := FindEncodingDesc(True);

//If so, pass it to the category list for loading of categories
    AnnCatList.ReadFromEncodingDesc(encodingDesc);

//Clear application version information
{Any code that should be used to parse and make use of the app info data
should be called here!}
    ClearAppInfo;


//Find the image markup divs
    AnnWrapperDiv := FindAnnWrapperDiv(False);
    FacsEl := FindFacsEl(False);
    if (AnnWrapperDiv <> nil) and (FacsEl <> nil) then
      IMTAnnList.ReadFromDomElements(AnnWrapperDiv, FacsEl, True);

//Now get the image file path.
    if FacsEl.getElementsByTagName('graphic').Length > 0 then
      begin
        GraphicEl := TDomElement(FacsEl.GetElementsByTagName('graphic').Item(0));
        ImageFilePath := GraphicEl.GetAttributeLiteralValue('url');
//If the path isn't a full path to an existing file...
//        if not WideFileExists(ImageFilePath) then //returns true when path is just a filename!
//... then try a reconstructing from a relative path
        if WGetFullPathFromRelative(FileName, ImageFilePath, wsTemp) = True then
            if FileExists(wsTemp) then
              ImageFilePath := wsTemp;
//If we still don't have a good file path...
        if not FileExists(ImageFilePath) then
          begin
//...try looking for a file of the same name in the same folder as the XML file
            wsTemp := ExtractFilePath(FileName) + ExtractFileName(ImageFilePath);
            if FileExists(wsTemp) then
              ImageFilePath := wsTemp;
//Any more things we can try????
          end;
      end;

//Now get the two header items we care about
    ReadTitleAndProjDescFromTeiHeader;

//Now try creating the divs
    if IMTAnnList.Count > 0 then
      for i := 0 to IMTAnnList.Count-1 do
        begin
          CreatePositionedLayer(i);
          if IMTAnnList.Showing[i] = False then
            TPositionedLayer(IMTAnnList.PositionedLayer[i]).LayerOptions :=
                  LOB_NO_UPDATE or LOB_NO_CAPTURE;
        end;

{TODO: Finally, do any consistency checking that's necessary (e.g. make sure
each annotation's CategoryID corresponds to a Category in the cat list.
Report or fix any errors.}
    Modified := False;
    Result := True;
  except
//Returning false is sufficient
  end;
end;

function TIMTDoc.FindFacsEl(CreateIfAbsent: Boolean): TDomElement;
var
TotalFacsEls, i: integer;
FacsEl: TDomElement;
RootEl: TDomElement;
Els: TDomNodeList;
TextEl: TDomElement;

begin
  Result := nil;
  FacsEl := nil;

//First, check there's anything useful there at all in the way of structure
  if DomDoc.GetElementsByTagName('TEI').Length < 1 then
    CreateSkeletonDoc;

  TotalFacsEls := DomDoc.GetElementsByTagName('facsimile').Length;
  if TotalFacsEls > 0 then
    for i := 0 to TotalFacsEls-1 do
      begin
        FacsEl := TDomElement(DomDoc.GetElementsByTagName('facsimile').Item(i));
        if FacsEl.GetAttributeNormalizedValue('xml:id') = imtWrapperType then
          begin
            Result := FacsEl;
            Exit;
          end;
      end;
  if (FacsEl = nil) and (CreateIfAbsent = True) then
    begin
      RootEl := TDomElement(DomDoc.GetElementsByTagName('TEI').Item(0));
      FacsEl := TDomElement.Create(DomDoc, 'facsimile');
      FacsEl.SetAttribute('xml:id', imtWrapperType);
//Bugfix for 1.8.1.6: we need to make sure that the facsimile element comes
//before the text element, otherwise the file will be invalid; therefore we
//can't just add it to the end.
//      RootEl.AppendChild(FacsEl);
      Els := RootEl.GetElementsByTagName('text');
      if Els.Length > 0 then
        RootEl.InsertBefore(FacsEl, Els.Item(0))
      else
        RootEl.AppendChild(FacsEl);

      Result := FacsEl;
    end;
end;

function TIMTDoc.FindAnnWrapperDiv(CreateIfAbsent: Boolean): TDomElement;
var
TotalDivs, i: integer;
DivEl: TDomElement;
BodyEl: TDomElement;

begin
  Result := nil;
  DivEl := nil;

//First, check there's anything useful there at all in the way of structure
  if DomDoc.GetElementsByTagName('body').Length < 1 then
    CreateSkeletonDoc;

  TotalDivs := DomDoc.GetElementsByTagName('div').Length;
  if TotalDivs > 0 then
    for i := 0 to TotalDivs-1 do
      begin
        DivEl := TDomElement(DomDoc.GetElementsByTagName('div').Item(i));
        if DivEl.GetAttributeNormalizedValue('xml:id') = imtAnnWrapperType then
          begin
            Result := DivEl;
            Exit;
          end;
      end;
  if (DivEl = nil) and (CreateIfAbsent = True) then
    begin
      BodyEl := TDomElement(DomDoc.GetElementsByTagName('body').Item(0));
      DivEl := TDomElement.Create(DomDoc, 'div');
      DivEl.SetAttribute('xml:id', imtAnnWrapperType);
      BodyEl.AppendChild(DivEl);
      Result := DivEl;
    end;
end;

//This function replaced for version 1.6 with new version below.
{function TIMTDoc.GetAppInfoNode: TDomElement;
var
appInfoEl: TDomElement;
appDetailEl: TDomElement;
ptrEl: TDomElement;
dateEl: TDomElement;
TextNode: TDomText;
VersionInfo: TAppVersionInfo;
DateTime: TDateTime;

begin
  Result := nil; //default
  VersionInfo := TAppVersionInfo.Create;
  try
    appInfoEl := TDomElement.Create(DomDoc, teiAppInfoTag);
    appInfoEl.SetAttribute('xml:id', VersionInfo.InternalName);
    ufrmXMLUtilities.AddIndentToNode(appInfoEl, DomDoc, 4);

    appDetailEl := TDomElement.Create(DomDoc, teiAppDetailTag);
    appDetailEl.SetAttribute('adType', teiAppName);
    ufrmXMLUtilities.AddIndentToNode(appDetailEl, DomDoc, 5);
    TextNode := TDomText.Create(DomDoc);
    TextNode.NodeValue := Application.Title;
    appDetailEl.AppendChild(TextNode);
    appInfoEl.AppendChild(appDetailEl);

    appDetailEl := TDomElement.Create(DomDoc, teiAppDetailTag);
    appDetailEl.SetAttribute('adType', teiAppURI);
    ufrmXMLUtilities.AddIndentToNode(appDetailEl, DomDoc, 5);
    TextNode := TDomText.Create(DomDoc);
    TextNode.NodeValue := VersionInfo.URL;
    appDetailEl.AppendChild(TextNode);
    appInfoEl.AppendChild(appDetailEl);

    appDetailEl := TDomElement.Create(DomDoc, teiAppDetailTag);
    appDetailEl.SetAttribute('adType', teiAppDesc);
    ufrmXMLUtilities.AddIndentToNode(appDetailEl, DomDoc, 5);
    TextNode := TDomText.Create(DomDoc);
    TextNode.NodeValue := VersionInfo.FileDescription;
    appDetailEl.AppendChild(TextNode);
    appInfoEl.AppendChild(appDetailEl);

    appDetailEl := TDomElement.Create(DomDoc, teiAppDetailTag);
    appDetailEl.SetAttribute('adType', teiAppVersion);
    ufrmXMLUtilities.AddIndentToNode(appDetailEl, DomDoc, 5);
    TextNode := TDomText.Create(DomDoc);
    TextNode.NodeValue := VersionInfo.DottedVersion;
    appDetailEl.AppendChild(TextNode);
    appInfoEl.AppendChild(appDetailEl);

    appDetailEl := TDomElement.Create(DomDoc, teiAppDetailTag);
    appDetailEl.SetAttribute('adType', teiSectionsTouched);
    ufrmXMLUtilities.AddIndentToNode(appDetailEl, DomDoc, 5);
    ptrEl := TDomElement.Create(DomDoc, 'ptr');
    ptrEl.SetAttribute('target', '#' + imtWrapperType);
    appDetailEl.AppendChild(ptrEl);
    ufrmXMLUtilities.AddIndentToNode(appDetailEl, DomDoc, 5);
    ptrEl := TDomElement.Create(DomDoc, 'ptr');
    ptrEl.SetAttribute('target', '#' + imtCategoryListID);
    appDetailEl.AppendChild(ptrEl);
    appInfoEl.AppendChild(appDetailEl);

    appDetailEl := TDomElement.Create(DomDoc, teiAppDetailTag);
    appDetailEl.SetAttribute('adType', teiLastSave);
    ufrmXMLUtilities.AddIndentToNode(appDetailEl, DomDoc, 5);
    dateEl := TDomElement.Create(DomDoc, 'date');
    DateTime := Now;

//Change for 1.6: @value changed to @when
    dateEl.SetAttribute('value', FormatDateTime('yyyy-mm-dd', DateTime) + 'T' +
                                  FormatDateTime('hh:mm:ss', DateTime));
    appDetailEl.AppendChild(dateEl);
    appInfoEl.AppendChild(appDetailEl);

    Result := appInfoEl;
  finally
    FreeAndNil(VersionInfo);
  end;
end;    }

//New version, updated for 1.6.
function TIMTDoc.GetAppInfoNode: TDomElement;
var
appInfoEl: TDomElement;
applicationEl: TDomElement;
labelEl: TDomElement;
descEl: TDomElement;
refEl: TDomElement;
ptrEl: TDomElement;
TextNode: TDomText;
VersionInfo: TAppVersionInfo;
DateTime: TDateTime;

begin
  Result := nil; //default
  VersionInfo := TAppVersionInfo.Create;
  try
    appInfoEl := TDomElement.Create(DomDoc, teiAppInfoTag);
    ufrmXMLUtilities.AddIndentToNode(appInfoEl, DomDoc, 5);

    applicationEl := TDomElement.Create(DomDoc, teiAppTag);
//New for 1.8.1.6: for Linux, this info is not successfully read from the
//version info block in the exe, so we need to supply it manually.
    if Length(VersionInfo.InternalName) > 0 then
      applicationEl.SetAttribute('ident', VersionInfo.InternalName)
    else
      applicationEl.SetAttribute('ident', appIdent);
    applicationEl.SetAttribute('version', VersionInfo.DottedVersion);
    DateTime := Now;
    applicationEl.SetAttribute('notAfter', FormatDateTime('yyyy-mm-dd', DateTime) + 'T' +
                                  FormatDateTime('hh:mm:ss', DateTime));
    ufrmXMLUtilities.AddIndentToNode(applicationEl, DomDoc, 5);
    appInfoEl.AppendChild(applicationEl);

    labelEl := TDomElement.Create(DomDoc, teiAppLabelTag);
    ufrmXMLUtilities.AddIndentToNode(labelEl, DomDoc, 5);
    TextNode := TDomText.Create(DomDoc);
    TextNode.NodeValue := Application.Title;
    labelEl.AppendChild(TextNode);
    applicationEl.AppendChild(labelEl);

    descEl := TDomElement.Create(DomDoc, teiAppDescTag);
    ufrmXMLUtilities.AddIndentToNode(descEl, DomDoc, 5);
    TextNode := TDomText.Create(DomDoc);
    TextNode.NodeValue := VersionInfo.FileDescription;
    descEl.AppendChild(TextNode);
    applicationEl.AppendChild(descEl);

    refEl := TDomElement.Create(DomDoc, teiAppRefTag);
    ufrmXMLUtilities.AddIndentToNode(refEl, DomDoc, 5);
    refEl.SetAttribute('type', 'appURI');
//New for 1.8.1.6: for Linux, this info is not successfully read from the
//version info block in the exe, so we need to supply it manually.
    if Length(VersionInfo.URL) > 0 then
      refEl.SetAttribute('target', VersionInfo.URL)
    else
      refEl.SetAttribute('target', appURI);;

    applicationEl.AppendChild(refEl);

    ufrmXMLUtilities.AddIndentToNode(appInfoEl, DomDoc, 5);
    ptrEl := TDomElement.Create(DomDoc, 'ptr');
    ptrEl.SetAttribute('target', '#' + imtWrapperType);
    applicationEl.AppendChild(ptrEl);
//New element for v 1.7
    ufrmXMLUtilities.AddIndentToNode(appInfoEl, DomDoc, 5);
    ptrEl := TDomElement.Create(DomDoc, 'ptr');
    ptrEl.SetAttribute('target', '#' + imtAnnWrapperType);
    applicationEl.AppendChild(ptrEl);

    ufrmXMLUtilities.AddIndentToNode(appInfoEl, DomDoc, 5);
    ptrEl := TDomElement.Create(DomDoc, 'ptr');
    ptrEl.SetAttribute('target', '#' + imtCategoryListID);
    applicationEl.AppendChild(ptrEl);

    Result := appInfoEl;
  finally
    FreeAndNil(VersionInfo);
  end;
end;     

function TIMTDoc.SaveToXMLFile(FileName: WideString; CopySchema: Boolean): Boolean;
var
Stream: TFileStream;
SchemaFile: WideString;

begin
  Result := False;
  try
//Clear previous data
    ClearAnnAndCatDataFromDoc;

//Add all the current data
    AddAnnAndCatDataToDoc(FileName);

//Stream to disk...

    Stream := TFileStream.Create(FileName, fmCreate or fmOpenWrite);
    try
      DomToXMLParser.WriteToStream(DomDoc, 'UTF-8', Stream);
      Modified := False;
      Result := True;
    finally
      FreeAndNil(Stream);
    end;
//If required, copy the schema
    if CopySchema then
      begin
        SchemaFile := WideExtractFilePath(Application.ExeName) + 'schemas\'
                          + imtSchemaFileName + '.rng';
        if WideFileExists(SchemaFile) then
          WideCopyFile(SchemaFile, WideExtractFilePath(FileName) + 
                              imtSchemaFileName + '.rng', False);
      end;
  except
    on E: Exception do MessageDlg(E.Message, mtWarning, [mbOK], E.HelpContext);
  end;
end;

function TIMTDoc.GetwsTEIHeader: WideString;
begin
  Result := '';
//Make sure there's a teiHeader in there
  if DomDoc.GetElementsByTagName('teiHeader').Length < 1 then
    CreateTeiHeader;
  try
//Clear any category data that's in there
    ClearTagsDecl;
//Clear any application information created by this app
    ClearAppInfo;

//then stream out the rest as a string
    DomToXMLParser.WriteToWideString(TDomElement(TeiHeaderEl), Result);
  except
  end;
end;

procedure TIMTDoc.ReadTitleAndProjDescFromTeiHeader;
var
SourceDescEl, pEl: TDomElement;

begin
  if fteiHeaderEl = nil then
    Exit;
    
  if fteiHeaderEl.GetElementsByTagName('title').Length > 0 then
    fDocTitle := TDomElement(fteiHeaderEl.getElementsByTagName('title').Item(0)).TextContent;

  if fteiHeaderEl.GetElementsByTagName('sourceDesc').Length > 0 then
    begin
      SourceDescEl := TDomElement(fteiHeaderEl.GetElementsByTagName('sourceDesc').Item(0));
      if SourceDescEl.GetElementsByTagName('p').Length > 0 then
        begin
          pEl := TDomElement(SourceDescEl.GetElementsByTagName('p').Item(0));
          fProjDesc := pEl.TextContent;
        end;
    end;
end;

procedure TIMTDoc.SetwsTEIHeader(const Value: WideString);
var
InXML: WideString;
OldHeaderXML: WideString;
OldHeaderNode, NewHeaderNode: TDomNode;
teiHeaderParent: TDomNode;
SourceDescEl, pEl: TDomElement;

begin
  InXML := WideTrim(Value);
//First, parse it to check it's OK
{  try
    tempNode := XMLToDomParser.ParseWideString(InXML, '', '', nil);
  except
    Exit; //TODO: Better error reporting here? Or should the string be checked
    //externally anyway, before it gets this far?
  end; }
//if so, then stream out any existing header
  DomToXMLParser.WriteToWideString(fteiHeaderEl, OldHeaderXML);
  OldHeaderXML := WideTrim(OldHeaderXML);

//Check whether the two strings are different.
//If so, then stream in the new string to the document
  if WideSameStr(InXML, OldHeaderXML) = False then
    begin
//Get a pointer to the parent of the current header
      teiHeaderParent := fteiHeaderEl.ParentNode;
//Create the new header
      NewHeaderNode := TDomDocumentFragment.Create(DomDoc);

      NewHeaderNode:= ufrmXMLUtilities.ParseWideStringToDomNode(InXML,
                                              DomDoc.DomImplementation,
                                              DomDoc);

//Insert it before the old one
      teiHeaderParent.InsertBefore(NewHeaderNode, fteiHeaderEl);
        
//Remove the old one
      teiHeaderParent.RemoveChild(TDomNode(fteiHeaderEl));
//Point the pointer at the new one
      fteiHeaderEl := TDomElement(DomDoc.GetElementsByTagName('teiHeader').Item(0));

//Now read back the Title and ProjDesc data
      ReadTitleAndProjDescFromTeiHeader;

//and set the modified flag
      Modified := True;
    end;
//    WideShowMessage(fDocTitle + ' :::: ' + fProjDesc);
end;

function TIMTDoc.GetCategoryIDList: TTntStrings;
var
i: integer;
begin
  fCategoryIDs.Clear;
  if AnnCatList.Count > 0 then
    for i := 0 to AnnCatList.Count-1 do
      fCategoryIDs.Add(AnnCatList.ID[i]);
  Result := fCategoryIDs;
end;

function TIMTDoc.FindEncodingDesc(CreateIfAbsent: Boolean): TDomElement;
var
teiHeader, encodingDesc: TDomElement;

begin
  Result := nil; //default
  if DomDoc.GetElementsByTagName('encodingDesc').Length > 0 then
    begin
      Result := TDomElement(DomDoc.GetElementsByTagName('encodingDesc').Item(0));
      Exit;
    end;
  if not CreateIfAbsent then
    Exit;
//There's no element, so we need to create one
  if DomDoc.GetElementsByTagName('teiHeader').Length > 0 then
    teiHeader := TDomElement(DomDoc.GetElementsByTagName('teiHeader').Item(0))
  else
    begin
      teiHeader := TDomElement.Create(DomDoc, 'teiHeader');
      DomDoc.DocumentElement.AppendChild(teiHeader);
    end;
  if teiHeader.GetElementsByTagName('encodingDesc').Length > 0 then
    encodingDesc := TDomElement(teiHeader.GetElementsByTagName('encodingDesc').Item(0))
  else
    begin
      encodingDesc := TDomElement.Create(DomDoc, 'encodingDesc');
      teiHeader.AppendChild(encodingDesc);
    end;
  Result := encodingDesc;
end;

procedure TIMTDoc.ClearAnnAndCatDataFromDoc;
begin
//Clear out the elements of the doc which are
//handled by our data structures (categories, rects and ann divs).

//First, tagsDecl
  ClearTagsDecl;

//Now, clear out any elements with our identifiers
  ClearFacsimile;
  ClearAnnDivs;


end;

function TIMTDoc.AddAnnAndCatDataToDoc(FileName: WideString): Boolean;
var
EncDescEl: TDomElement;
AppInfoEl: TDomElement;
FacsEl: TDomElement;
AnnWrapperEl: TDomElement;
SurfaceEl: TDomElement;
GraphicEl: TDomElement;
XMLID: WideString;

begin
  Result := False;
  try
//Add Category info to the teiHeader element
    EncDescEl := FindEncodingDesc(True);
    AnnCatList.WriteToEncodingDesc(EncDescEl, DomDoc);

//Clear previous app info
    ClearAppInfo;

//Make an XML ID attribute value for the root element.
    XMLID := WideChangeFileExt(WideExtractFileName(FileName), '');
    if ufrmXMLUtilities.MakeXMLNCName(XMLID) then
//Set the attribute on the root element
      DomDoc.DocumentElement.SetAttribute('xml:id', XMLID);

//Add the application version info
    AppInfoEl := AppInfoNode;
    EncDescEl.AppendChild(AppInfoEl);

//Find or create the facs and wrapper divs
    FacsEl := FindFacsEl(True);
    AnnWrapperEl := FindAnnWrapperDiv(True);

//Create the <figure> element needed to wrap the svg (for version 1.3).
    SurfaceEl := TDomElement.Create(DomDoc, 'surface');
    FacsEl.AppendChild(SurfaceEl);


//Add the image information
    GraphicEl := TDomElement.Create(DomDoc, 'graphic');
{If there's a filename we're saving to, use an image path relative to it.
If not, use the full path.}
    if Length(FileName) > 0 then
      GraphicEl.SetAttribute('url', ExtractRelativePath(FileName, ImageFilePath))
    else
      GraphicEl.SetAttribute('url', ImageFilePath);
    if fImgView32 <> nil then
      begin
        GraphicEl.SetAttribute('width', IntToStr(fImgView32.Bitmap.Width) + 'px');
        GraphicEl.SetAttribute('height', IntToStr(fImgView32.Bitmap.Height) + 'px');
      end;

    SurfaceEl.AppendChild(GraphicEl);

//Call the annlist to add all the rect elements
    IMTAnnList.WriteRectsToDomElement(SurfaceEl, DomDoc);

//Call the annlist again to add all the divs for annotations
    IMTAnnList.WriteDivsToDomElement(AnnWrapperEl, DomDoc);

    Result := True;
  except
//Returning false is enough
  end;
end;

procedure TIMTDoc.SetImageFilePath(const Value: WideString);
var
TrimVal: WideString;
begin
  TrimVal := WideTrim(Value);
  if fImageFilePath <> TrimVal then
    begin
      fImageFilePath := TrimVal;
      Modified := True;
    end;
end;

procedure TIMTDoc.SetProjDesc(const Value: WideString);
var
TrimVal: WideString;
SourceDescEl, pEl: TDomElement;
TextNode: TDomText;
begin
  TrimVal := WideTrim(Value);
  if fProjDesc <> TrimVal then
    begin
      fProjDesc := TrimVal;
      Modified := True;
//Now set the corresponding field in the teiHeader
      if fteiHeaderEl <> nil then
        begin
          if fteiHeaderEl.GetElementsByTagName('sourceDesc').Length > 0 then
            begin
              SourceDescEl := TDomElement(fteiHeaderEl.GetElementsByTagName('sourceDesc').Item(0));
              if SourceDescEl.GetElementsByTagName('p').Length > 0 then
                begin
                  pEl := TDomElement(SourceDescEl.GetElementsByTagName('p').Item(0));
                  pEl.Clear;
                  TextNode := TDomText.Create(DomDoc);
                  TextNode.NodeValue := ProjDesc;
                  pEl.AppendChild(TextNode);
                end;
            end;
        end;
    end;
end;

procedure TIMTDoc.SetDocTitle(const Value: WideString);
var
TrimVal: WideString;
TitleStmtEl, TitleEl: TDomElement;
TextNode: TDomText;
begin
  TrimVal := WideTrim(Value);
  if fDocTitle <> TrimVal then
    begin
      fDocTitle := TrimVal;
      Modified := True;
//Now set the corresponding field in the teiHeader
      if fteiHeaderEl <> nil then
        begin
          if fteiHeaderEl.GetElementsByTagName('titleStmt').Length > 0 then
            begin
              TitleStmtEl := TDomElement(fteiHeaderEl.GetElementsByTagName('titleStmt').Item(0));
              if TitleStmtEl.GetElementsByTagName('title').Length > 0 then
                begin
                  TitleEl := TDomElement(TitleStmtEl.GetElementsByTagName('title').Item(0));
                  TitleEl.Clear;
                  TextNode := TDomText.Create(DomDoc);
                  TextNode.NodeValue := DocTitle;
                  TitleEl.AppendChild(TextNode);
                end;
            end;
        end;
    end;
end;

procedure TIMTDoc.CreateSkeletonDoc;
var
TemplatePath: WideString;
ProcInst: TDomProcessingInstruction;
RootNode: TDomElement;
FacsEl, TextEl, BodyEl, DivEl: TDomElement;

begin
//First: Clear the doc
  DomDoc.Clear;
  fteiHeaderEl := nil;

  TemplatePath := WideExtractFilePath(Application.ExeName) + 'templates\' +
                                      imtSchemaFileName + '.xml';

//Now try to load the template
  if WideFileExists(TemplatePath) then
    begin
      DomDoc := XMLToDomParser.ParseFile(TemplatePath, False);
      if DomDoc.GetElementsByTagName('teiHeader').Length > 0 then
        fteiHeaderEl := TDomElement(DomDoc.getElementsByTagName('teiHeader').Item(0));
    end
//If no template, construct a document from scratch
  else
    begin
//New for 1.5: use processing instructions to link to RelaxNG schema.
      ProcInst := TDomProcessingInstruction.Create(DomDoc, 'oasis-schema');
      ProcInst.Data := 'href="' + imtSchemaFileName + '.rng" type="application/xml"';
      DomDoc.AppendChild(ProcInst);
      ProcInst := TDomProcessingInstruction.Create(DomDoc, 'oxygen');
      ProcInst.Data := 'RNGSchema="' + imtSchemaFileName + '.rng" type="xml"';
      DomDoc.AppendChild(ProcInst);

      RootNode := TDomElement.Create(DomDoc, 'TEI');
{Following approach abandoned from v. 1.5 onwards; we have moved to RNG instead
of XSD.}
      {
      RootNode.SetAttribute('xmlns:xsi', 'http://www.w3.org/2001/XMLSchema-instance');

      RootNode.SetAttribute('xsi:schemaLocation', 'http://www.tei-c.org/ns/1.0 ' +
                                                   imtSchemaFileName + '.xsd');
      }
//Removed for 1.7 -- no more svg:
//      RootNode.SetAttribute('xmlns:svg', 'http://www.w3.org/2000/svg');

      RootNode.SetAttribute('xmlns', 'http://www.tei-c.org/ns/1.0');
      RootNode.SetAttribute('version', '5.0');
      DomDoc.AppendChild(RootNode);
      CreateTeiHeader;

//New for version 1.7
      FacsEl := TDomElement.Create(DomDoc, 'facsimile');
      FacsEl.SetAttribute('xml:id', imtWrapperType);
      RootNode.AppendChild(FacsEl);

      TextEl := TDomElement.Create(DomDoc, 'text');
      RootNode.AppendChild(TextEl);
      BodyEl := TDomElement.Create(DomDoc, 'body');
      TextEl.AppendChild(BodyEl);
      DivEl := TDomElement.Create(DomDoc, 'div');
      DivEl.SetAttribute('xml:id', imtAnnWrapperType);
      BodyEl.AppendChild(DivEl);
    end;
end;

{function TIMTDoc.ImportFromDocBookArticle(FileName: WideString): Boolean;
begin

end; }

{function TIMTDoc.ExportToDocBookArticle(FileName: WideString): Boolean;
begin

end;  }

function TIMTDoc.CreateTeiHeader: Boolean;
var
//These are all the core elements needed for a valid header:
teiHeader, fileDesc, titleStmt, title, publicationStmt, p, sourceDesc: TDomElement;
//This is needed for writing our own tagsDecl for the category info:
encodingDesc: TDomElement;
TextNode: TDomText;

begin
  Result := False;
//Only create a new header if there isn't one
  if DomDoc.GetElementsByTagName('teiHeader').Length > 0 then
    begin
      fTeiHeaderEl := TDomElement(DomDoc.GetElementsByTagName('teiHeader').Item(0));
      Exit;
    end;
//There's no element, so we need to create one
  try
    teiHeader := TDomElement.Create(DomDoc, 'teiHeader');
    DomDoc.DocumentElement.AppendChild(teiHeader);
    ufrmXMLUtilities.AddIndentToNode(teiHeader, DomDoc, 2);
    fileDesc := TDomElement.Create(DomDoc, 'fileDesc');
    teiHeader.AppendChild(fileDesc);
    ufrmXMLUtilities.AddIndentToNode(fileDesc, DomDoc, 4);
    titleStmt := TDomElement.Create(DomDoc, 'titleStmt');
    fileDesc.AppendChild(titleStmt);
    ufrmXMLUtilities.AddIndentToNode(fileDesc, DomDoc, 6);
    title := TDomElement.Create(DomDoc, 'title');
//Create a text node to encode the title
    TextNode := TDomText.Create(DomDoc);
    TextNode.NodeValue := fDocTitle;
    title.AppendChild(TextNode);
    titleStmt.AppendChild(title);
    ufrmXMLUtilities.AddIndentToNode(fileDesc, DomDoc, 4);
    publicationStmt := TDomElement.Create(DomDoc, 'publicationStmt');
    fileDesc.AppendChild(publicationStmt);
    ufrmXMLUtilities.AddIndentToNode(publicationStmt, DomDoc, 6);
    p := TDomElement.Create(DomDoc, 'p');
    publicationStmt.AppendChild(p);
    ufrmXMLUtilities.AddIndentToNode(fileDesc, DomDoc, 4);
    sourceDesc := TDomElement.Create(DomDoc, 'sourceDesc');
    fileDesc.AppendChild(sourceDesc);
    p := TDomElement.Create(DomDoc, 'p');
//Create a text node for the project description
    TextNode := TDomText.Create(DomDoc);
    TextNode.NodeValue := fProjDesc;
    p.AppendChild(TextNode);
    ufrmXMLUtilities.AddIndentToNode(sourceDesc, DomDoc, 4);
    sourceDesc.AppendChild(p);
    encodingDesc := TDomElement.Create(DomDoc, 'encodingDesc');
    ufrmXMLUtilities.AddIndentToNode(teiHeader, DomDoc, 2);
    teiHeader.AppendChild(encodingDesc);

//Point the header variable at the new element
    if DomDoc.GetElementsByTagName('teiHeader').Length > 0 then
      begin
        fTeiHeaderEl := TDomElement(DomDoc.GetElementsByTagName('teiHeader').Item(0));
        Result := True; //we succeeded
      end
    else
      Result := False;
  except
//Returning false will be enough
  end;
end;

procedure TIMTDoc.ClearTagsDecl;
var
i: integer;
tagsDecl: TDomElement;

begin
  if DomDoc.GetElementsByTagName('tagsDecl').Length > 0 then
    for i := DomDoc.GetElementsByTagName('tagsDecl').Length-1 downto 0 do
      begin
        tagsDecl := TDomElement(DomDoc.GetElementsByTagName('tagsDecl').Item(i));
        if tagsDecl.GetAttributeNormalizedValue('xml:id') = imtCategoryListID then
          begin
            tagsDecl.ParentNode.RemoveChild(tagsDecl);
            FreeAndNil(tagsDecl);
          end;
      end;
end;

procedure TIMTDoc.ClearAppInfo;
var
i: integer;
appInfo: TDomNode;
app: TDomElement;
//VersionInfo: TAppVersionInfo;

begin
//This function modified to remove reliance on VersionInfo.InternalName, because
//that fails on Linux. Changed for version 1.8.1.7.
  //VersionInfo := TAppVersionInfo.Create;
  //try
    if DomDoc.GetElementsByTagName(teiAppTag).Length > 0 then
      for i := DomDoc.GetElementsByTagName(teiAppTag).Length-1 downto 0 do
        begin
          app := TDomElement(DomDoc.GetElementsByTagName(teiAppTag).Item(i));
          //Change for v 1.6: xml:id goes to ident.
          //if appInfo.GetAttributeNormalizedValue('xml:id') = VersionInfo.InternalName then
          //if app.GetAttributeNormalizedValue('ident') = VersionInfo.InternalName then
          if app.GetAttributeNormalizedValue('ident') = appIdent then
            begin
              appInfo := app.ParentNode;
              appInfo.RemoveChild(app);
              FreeAndNil(app);
//If the appInfo tag has no further content, then we might as well remove it.
              if TDomElement(appInfo).GetElementsByTagName(teiAppTag).Length < 1 then
                begin
                  appInfo.ParentNode.RemoveChild(appInfo);
                  FreeAndNil(appInfo);
                end;
            end;
        end;
  //finally
  //  FreeAndNil(VersionInfo);
  //end;
end;

//New procedure for 1.7
procedure TIMTDoc.ClearFacsimile;
var
i: integer;
El: TDomElement;
Parent: TDomNode;

begin
  if DomDoc.GetElementsByTagName('facsimile').Length > 0 then
    for i := DomDoc.GetElementsByTagName('facsimile').Length-1 downto 0 do
      begin
        El := TDomElement(DomDoc.GetElementsByTagName('facsimile').Item(i));
        if (El.GetAttributeNormalizedValue('xml:id') = imtWrapperType) then
          begin
            El.Clear;
            El.SetAttribute('xml:id', imtWrapperType);
          end;
      end;
end;

procedure TIMTDoc.ClearAnnDivs;
var
i: integer;
El: TDomElement;
Parent: TDomNode;

begin
  if DomDoc.GetElementsByTagName('div').Length > 0 then
    for i := DomDoc.GetElementsByTagName('div').Length-1 downto 0 do
      begin
        El := TDomElement(DomDoc.GetElementsByTagName('div').Item(i));
//New for 1.7: changed imtWrapperType to imtAnnWrapperType

        if (El.GetAttributeNormalizedValue('xml:id') = imtAnnWrapperType) then
          begin
            El.Clear;
            El.SetAttribute('xml:id', imtAnnWrapperType);
          end;
      end;
end;

function TIMTDoc.GetTEIHeaderEl: TDomElement;
begin
  if fTeiHeaderEl = nil then
    CreateTeiHeader;
  Result := fTeiHeaderEl;
end;

procedure TIMTDoc.Empty;
begin
  DomDoc.Clear;
  AnnCatList.Empty;
  IMTAnnList.Empty;
  if fImgView32 <> nil then
    fImgView32.Layers.Clear;
  fDocTitle := '';
  fProjDesc := '';
  ImageFilePath := '';
  fteiHeaderEl := nil;
  CreateSkeletonDoc;
  Modified := False;
end;

procedure TIMTDoc.PartialClear(ClearDomDoc, ClearCategories, ClearAnnotations,
                               ClearLayers: Boolean);
begin
  if ClearDomDoc then
    DomDoc.Clear;
  if ClearCategories then
    AnnCatList.Empty;
  if ClearAnnotations then
    IMTAnnList.Empty;
  if ClearLayers then
    fImgView32.Layers.Clear;
  Modified := False;
end;

function TIMTDoc.GetAnnShowing(Index: integer): Boolean;
begin
  Result := False; //default
  if IMTAnnList.IndexInRange(Index) then
    Result := IMTAnnList.Showing[Index];
end;

procedure TIMTDoc.SetAnnShowing(Index: integer; const Value: Boolean);
begin
//Sanity check:
  if not IMTAnnList.IndexInRange(Index) then
    Exit;

//First, check if it's different from before
  if IMTAnnList.Showing[Index] <> Value then
    IMTAnnList.Showing[Index] := Value;
end;

function TIMTDoc.CreatePositionedLayer(AnnIndex: integer): TPositionedLayer;
var
  P: TPoint;
  ScaledSize: integer;
  Ann: TIMTAnnotation;
  ViewportRect: TRect;
begin
  Result := nil; //default in case of failure


  if fImgView32 <> nil then
    begin
//Create the new layer
      Result := TPositionedLayer.Create(fImgView32.Layers);
      Result.Scaled := True;
//If the annotation already has coordinates, then use them:
      if IMTAnnList.Width[AnnIndex] > 0 then
        begin
          Result.Location := FloatRect(IMTAnnList.Left[AnnIndex],
                               IMTAnnList.Top[AnnIndex],
                               IMTAnnList.Right[AnnIndex],
                               IMTAnnList.Bottom[AnnIndex]);
        end
      else
        begin
//This is a new item, so we have to create it afresh

// get coordinates of the center of viewport
          with fImgView32.GetViewportRect do
            P := fImgView32.ControlToBitmap(Point((Right + Left) div 2, (Top + Bottom) div 2));

          ScaledSize := Round(32*(1/fImgView32.Scale));
          Result.Location := FloatRect(P.X - ScaledSize,
                              P.Y - ScaledSize,
                              P.X + ScaledSize,
                              P.Y + ScaledSize);
        end;
      Result.MouseEvents := True;
      Result.OnPaint := LayerDrawingHandler;
      Result.Tag := AnnIndex;
      TIMTAnnotation(IMTAnnList[AnnIndex]).PositionedLayer := Result;
    end;

end;

function TIMTDoc.DestroyPositionedLayer(AnnIndex: integer): Boolean;
begin
  if IMTAnnList.PositionedLayer[AnnIndex] <> nil then
    begin
      fImgView32.Layers.Delete(IMTAnnList.PositionedLayer[AnnIndex].Index);
      IMTAnnList.PositionedLayer[AnnIndex] := nil;
    end;
end;

function TIMTDoc.GetXML: WideString;
var
wsOut: WideString;
begin
  Result := '';

//Clear previous data
  ClearAnnAndCatDataFromDoc;

//Add all the current data
  AddAnnAndCatDataToDoc('');

//Create the string
  DomToXMLParser.WriteToWideString(DomDoc, wsOut);
  Result := wsOut;
end;

function TIMTDoc.AddAnnotation: integer;
begin
//Add a new annotation
  Result := IMTAnnList.AddAnnotation;
//If there's no category in the list, add a default category
  if AnnCatList.Count < 1 then
    AnnCatList.AddCategory(wsDefaultCategoryID);
  IMTAnnList.CategoryID[Result] := AnnCatList.ID[0];
end;

function TIMTDoc.AddAnnotation(CategoryID: WideString): integer;
var
CatNum: integer;

begin
//Add a new annotation
  Result := IMTAnnList.AddAnnotation;
{Check whether this categeory exists or not; if not, create it.}
  if AnnCatList.FindCategoryNumFromID(CategoryID) < 0 then
    begin
      CatNum := AnnCatList.AddCategory(wsDefaultCategoryID);
{The process of creating the id might change it through enforcement of
rules regarding form, so we need to retrieve it.}
      IMTAnnList.CategoryID[Result] := AnnCatList.ID[CatNum];
    end
  else
    IMTAnnList.CategoryID[Result] := CategoryID;
end;

procedure TIMTDoc.LayerDrawingHandler(Sender: TObject; Buffer: TBitmap32);
var
  Cx, Cy: Single;
  W2, H2: Single;
  I: Integer;
  ShapeColor: TColor;
  ShapeColor32: TColor32;
  ShapeType: integer;
  AnnNum: integer;
  CatID: WideString;
begin
  if Sender is TPositionedLayer then
    begin
//Get the index of the annotation
      AnnNum := TPositionedLayer(Sender).Tag;
      CatID := IMTAnnList.CategoryID[AnnNum];
      ShapeColor := AnnCatList.GetColorFromCatID(CatID);
      ShapeColor32 := Color32(ShapeColor);
      ShapeType := AnnCatList.GetShapeFromCatID(CatID);
      case ShapeType of
        asSpiral:
          begin
            with TPositionedLayer(Sender).GetAdjustedLocation do
              begin
                Buffer.Canvas.Lock;
                W2 := (Right - Left) / 2;
                H2 := (Bottom - Top) / 2;
                Cx := Left + W2;
                Cy := Top + H2;
                Buffer.PenColor := ShapeColor32;
                Buffer.MoveToF(Cx,Cy);
                for I := 0 to 240 do
                  begin
              //This draws the red spiral
                    Buffer.LineToFS(Cx + W2 * I / 200 * Cos(I / 8), Cy + H2 * I / 200 * Sin(I / 8));
                  end;
                Buffer.Canvas.Unlock;
              end;
          end;
        asRectangle:
          begin
            with TPositionedLayer(Sender).GetAdjustedLocation do
              begin
                Buffer.Canvas.Lock;
                Buffer.FrameRectTS(round(Left+1), round(Top+1), round(Right-1), round(Bottom-1),
                                  ShapeColor32);
                Buffer.Canvas.Unlock;
              end;
          end;
        asCross:
          begin
            with TPositionedLayer(Sender).GetAdjustedLocation do
              begin
                Buffer.Canvas.Lock;
                Buffer.LineAS(round(Left), round(Top), round(Right), round(Bottom),
                                  ShapeColor32, True);
                Buffer.LineAS(round(Left), round(Bottom), round(Right), round(Top),
                                  ShapeColor32, True);
                Buffer.Canvas.Unlock;
              end;
          end;
        asEllipse:
          begin
            with TPositionedLayer(Sender).GetAdjustedLocation do
              begin
                Buffer.Canvas.Lock;
                Buffer.Canvas.Brush.Style := bsClear;
                Buffer.Canvas.Pen.Color := ShapeColor;
                Buffer.Canvas.Ellipse(round(Left), round(Bottom), round(Right), round(Top));
                Buffer.Canvas.Unlock;
              end;
          end;
      end; //end case
    end; //end if Sender is TPositionedLayer
end;

function TIMTDoc.DeleteAnnotation(Index: integer): Boolean;
begin
  if IMTAnnList.IndexInRange(Index) then
    begin
//First free any positionedlayer that exists
      DestroyPositionedLayer(Index);
      IMTAnnList.DeleteAnnotation(Index);
    end;
end;



function TIMTDoc.VisibleState(CatID: WideString): TCheckBoxState;
var
i: integer;
Anns: TIntegerList;
Showing: Boolean;

begin
  Result := cbUnchecked; //default
  if IMTAnnList.Count < 1 then
    Exit;
  Anns := TIntegerList.Create;
  try
    for i := 0 to IMTAnnList.Count-1 do
      if (CatID = '') or (IMTAnnList.CategoryID[i] = CatID) then
        Anns.Add(i);
    if Anns.Count > 0 then
      begin
        Showing := AnnShowing[Anns[0]];
        if Showing then
          Result := cbChecked;
        if Anns.Count > 1 then
          for i := 1 to Anns.Count-1 do
            if Showing <> AnnShowing[Anns[i]] then
              Result := cbGrayed;
      end;
  finally
    Anns.Free;
  end;

end;

procedure TIMTDoc.SetCategoryProperties(CatNum, NewShape: integer;
  NewColor: TColor; NewExplanation: WideString;
  NewTranscriptional: Boolean; NewCatID: WideString);
var
i: integer;
OldCatID: WideString;

begin
//Trim everything first
  NewExplanation := WideTrim(NewExplanation);
  NewCatID := WideTrim(NewCatID);

//Only do anything if something has changed
  if (AnnCatList.Shape[CatNum] <> NewShape) or
      (AnnCatList.Color[CatNum] <> NewColor) or
      (AnnCatList.Explanation[CatNum] <> NewExplanation) or
      (AnnCatList.ID[CatNum] <> NewCatID) or
      (AnnCatList.Transcriptional[CatNum] <> NewTranscriptional)
      then

    begin
//Set all the properties of the category
      AnnCatList.Shape[CatNum] := NewShape;
      AnnCatList.Color[CatNum] := NewColor;
      AnnCatList.Explanation[CatNum] := NewExplanation;
      AnnCatList.Transcriptional[CatNum] := NewTranscriptional;
//Get a copy of the old id
      OldCatID := AnnCatList.ID[CatNum];
      AnnCatList.ID[CatNum] := NewCatID;
//Now update any annotations that have this category, and cause them
//to repaint themselves
      IMTAnnList.CategoryChanged(OldCatID, NewCatID);
    end;
end;

function TIMTDoc.CanDeleteCategory(CategoryID: WideString): Boolean;
var
i: integer;

begin
//This function basically checks whether there are any annotations with this
//category; if so, then it can't be deleted until they are re-assigned.
  Result := True;
  if IMTAnnList.Count > 0 then
    for i := 0 to IMTAnnList.Count-1 do
      if IMTAnnList.CategoryID[i] = CategoryID then
        Result := False;
end;

function TIMTDoc.DeleteCategory(CategoryID: WideString): Boolean;
var
CatNum: integer;

begin
  Result := False;
  if CanDeleteCategory(CategoryID) then
    begin
      CatNum := AnnCatList.FindCategoryNumFromID(CategoryID);
      if CatNum > -1 then
        if AnnCatList.DeleteCategory(CatNum) then
          Result := True;
    end;
end;

function TIMTDoc.ListAnnsForCatID(IntList: TIntegerList; CatID: WideString): integer;
var
i: integer;

begin
  IntList.Clear;
  if IMTAnnList.Count > 0 then
    for i := 0 to IMTAnnList.Count-1 do
      if IMTAnnList.CategoryID[i] = CatID then
        IntList.Add(i);
  Result := IntList.Count;
end;

procedure TIMTDoc.ScrollAnnToCenter(AnnNum: integer);
begin
//This scrolls the image to make the selected annotation centred in the viewport
  if fImgView32 <> nil then
    if IMTAnnList.IndexInRange(AnnNum) then
      if IMTAnnList.PositionedLayer[AnnNum] <> nil then
        fImgView32.ScrollToCenter(IMTAnnList.CenterPoint[AnnNum].X,
                                  IMTAnnList.CenterPoint[AnnNum].Y);
end;

function TIMTDoc.SwapCategories(CatNum1, CatNum2: integer): Boolean;
begin
  Result := AnnCatList.SwapCategories(CatNum1, CatNum2);
end;

function TIMTDoc.FindAll(SearchFor, ReplaceWith: WideString;
                      Down, MatchCase, WholeWordOnly: Boolean;
                      DoReplace: Boolean; var TotalReplacements: integer;
                      var FailedReplacements: integer): integer;
var
i: integer;
wsTemp: WideString;
Replacements: integer;

begin
  SearchList.ClearAll;
  SearchList.Down := Down;
  Result := 0; //default
  TotalReplacements := 0; //starting number...
  FailedReplacements := 0;
  try
    Application.ProcessMessages;
//Search the teiHeader
    Replacements := SearchList.SearchContainer(ctHeader, -1, MatchCase, WholeWordOnly,
                               SearchFor, GetwsTeiHeader,
                               ReplaceWith, DoReplace, wsTemp);
    if DoReplace and (Replacements > 0) then
      if wsTemp <> GetwsTeiHeader then
        if ufrmXMLUtilities.IsWellFormedXMLFragment(wsTemp) then
          begin
            SetwsTEIHeader(wsTemp);
//This was successful, so count these replacements
            TotalReplacements := TotalReplacements + Replacements;
          end
        else
          FailedReplacements := FailedReplacements + Replacements;
    Application.ProcessMessages;
//Search each annotation...
    if IMTAnnList.Count > 0 then
      for i := 0 to IMTAnnList.Count-1 do
        begin
      //...the title...
          Replacements := SearchList.SearchContainer(ctAnnTitle, i, MatchCase,
                                           WholeWordOnly,
                                           SearchFor, IMTAnnList.AnnTitle[i],
                                           ReplaceWith, DoReplace, wsTemp);
          if DoReplace and (Replacements > 0) then
            if wsTemp <> IMTAnnList.AnnTitle[i] then
              if ufrmXMLUtilities.IsWellFormedXMLFragment(wsTemp) then
                begin
                  IMTAnnList.AnnTitle[i] := wsTemp;
//This was successful, so count these replacements
                  TotalReplacements := TotalReplacements + Replacements;
                end
              else
                FailedReplacements := FailedReplacements + Replacements;
      //...then the body
          Replacements := SearchList.SearchContainer(ctAnnText, i, MatchCase,
                                           WholeWordOnly,
                                           SearchFor, IMTAnnList.AnnText[i],
                                           ReplaceWith, DoReplace, wsTemp);
          if DoReplace and (Replacements > 0) then
            if wsTemp <> IMTAnnList.AnnText[i] then
              if ufrmXMLUtilities.IsWellFormedXMLFragment(wsTemp) then
                begin
                  IMTAnnList.AnnText[i] := wsTemp;
//This was successful, so count these replacements
                  TotalReplacements := TotalReplacements + Replacements;
                end
              else
                FailedReplacements := FailedReplacements + Replacements;
          Application.ProcessMessages;
        end;
//Search each category...
    if AnnCatList.Count > 0 then
      for i := 0 to AnnCatList.Count-1 do
        begin
//...the id...
          Replacements := SearchList.SearchContainer(ctCatId, i, MatchCase,
                                           WholeWordOnly,
                                           SearchFor, AnnCatList.ID[i],
                                           ReplaceWith, DoReplace, wsTemp);
          if DoReplace and (Replacements > 0) then
            if wsTemp <> AnnCatList.ID[i] then
              begin
                AnnCatList.ID[i] := wsTemp;
//This was successful, so count these replacements
                TotalReplacements := TotalReplacements + Replacements;
              end
            else
              FailedReplacements := FailedReplacements + Replacements;
//...then the description
          Replacements := SearchList.SearchContainer(ctCatExplanation, i, MatchCase,
                                           WholeWordOnly,
                                           SearchFor, AnnCatList.Explanation[i],
                                           ReplaceWith, DoReplace, wsTemp);
          if DoReplace and (Replacements > 0) then
            if wsTemp <> AnnCatList.Explanation[i] then
              if ufrmXMLUtilities.IsWellFormedXMLFragment(wsTemp) then
                begin
                  AnnCatList.Explanation[i] := wsTemp;
//This was successful, so count these replacements
                  TotalReplacements := TotalReplacements + Replacements;
                end
              else
                FailedReplacements := FailedReplacements + Replacements;
          Application.ProcessMessages;
        end;

//return the total hits.
    Result := SearchList.Count; //number of hits found.

//TODO: Do we need to redisplay stuff from the document from here, or should the
//calling GUI form take care of that?




  except
    WideShowMessage('Search system failure!');
  end;
end;

function TIMTDoc.FindNext(SearchFor: WideString;
                          StartFrom: TIMTSelection;
                          MatchCase, WholeWordOnly: Boolean;
                          var FoundHit: TIMTSelection;
                          Down, Wraparound: Boolean): Boolean;


{This sub-function gets us the next document component we need to search in,
in the form of a TIMTSelection. We're using TIMTSelection for convenience
because it has all of the members we need, but obviously we don't need all
its selection-related info in this particular context. }
  function GetNextItem(CurrItem: TIMTSelection; NextItem: TIMTSelection): Boolean;
  begin
    Result := False; //default; no subsequent container
    Case CurrItem.ContType of
      ctNone: //Assume something went wrong, and return ctNone again.
        begin
          NextItem.ContType := ctNone;
          NextItem.ItemIndex := -1;
          NextItem.SelStart := -1;
        end;
//TODO: Complete this code, then the main function.
      ctHeader:
        begin
          if Down then
            begin
//Are there annotations? If so, use the first, and return its title.
              if IMTAnnList.Count > 0 then
                begin
                  NextItem.ContType := ctAnnTitle;
                  NextItem.ItemIndex := 0;
                  NextItem.SelStart := -1;
                  Result := True;
                end
//If not, then are there categories? If so, use the first, and return its catid.
              else
                begin
                  if AnnCatList.Count > 0 then
                    begin
                      NextItem.ContType := ctCatId;
                      NextItem.ItemIndex := 0;
                      NextItem.SelStart := -1;
                      Result := True;
                    end;
                end;
//If not that, then return ctNone. No point wrapping around to self.
            end
          else
            begin
//Are we wrapping around? If not, then return ctNone...
              if Wraparound then
                begin
//Otherwise, are there categories? If so, return the cat explanation of the last.
                  if AnnCatList.Count > 0 then
                    begin
                      NextItem.ContType := ctCatExplanation;
                      NextItem.ItemIndex := AnnCatList.Count-1;
                      NextItem.SelStart := Length(AnnCatList.Explanation[AnnCatList.Count-1]);
                      Result := True;
                    end
                  else
//If not, are there annotations? If so, return the ann text of the last...
                    if IMTAnnList.Count > 0 then
                      begin
                        NextItem.ContType := ctAnnText;
                        NextItem.ItemIndex := IMTAnnList.Count-1;
                        NextItem.SelStart := Length(IMTAnnList.AnnText[IMTAnnList.Count-1]);
                        Result := True;
                      end;
                end;
//Otherwise, return ctNone.
            end;
        end;
      ctAnnTitle:
        begin
          if Down then
            begin
//Return ann text of current annotation.
              NextItem.ContType := ctAnnText;
              NextItem.ItemIndex := CurrItem.ItemIndex;
              NextItem.SelStart := -1;
              Result := True;
            end
          else
            begin
//Are there preceding annotations? If so, return the ann text of the one before
              if CurrItem.ItemIndex > 0 then
                begin
                  NextItem.ContType := ctAnnText;
                  NextItem.ItemIndex := CurrItem.ItemIndex - 1;
                  NextItem.SelStart := Length(IMTAnnList.AnnText[CurrItem.ItemIndex-1]);
                  Result := True;
                end
              else
//if not, return ctHeader.
                begin
                  NextItem.ContType := ctHeader;
                  NextItem.ItemIndex := -1;
                  NextItem.SelStart := Length(wsTEIHeader);
                  Result := True;
                end;
            end;
        end;
      ctAnnText:
        begin
          if Down then
            begin
//Are there subsequent annotations? If so, return the ann title of the next one...
              if CurrItem.ItemIndex < (IMTAnnList.Count-1) then
                begin
                  NextItem.ContType := ctAnnTitle;
                  NextItem.ItemIndex := CurrItem.ItemIndex + 1;
                  NextItem.SelStart := -1;
                  Result := True;
                end
              else
                begin
//Otherwise, are there categories? If so, return the catid of the first...
                  if AnnCatList.Count > 0 then
                    begin
                      NextItem.ContType := ctCatId;
                      NextItem.ItemIndex := 0;
                      NextItem.SelStart := -1;
                      Result := True;
                    end
                  else
                    begin
                      NextItem.ContType := ctHeader;
//Otherwise, return ctHeader.
                      NextItem.SelStart := -1;
                      NextItem.ItemIndex := -1;
                    end;
                end;
            end
          else
            begin
//Return the ann title of the current annotation.
              NextItem.ContType := ctAnnTitle;
              NextItem.ItemIndex := CurrItem.ItemIndex;
              NextItem.SelStart := Length(IMTAnnList.AnnTitle[CurrItem.ItemIndex]);
              Result := True;
            end;
        end;
      ctCatId:
        begin
          if Down then
            begin
//Return the explanation of the current category
              NextItem.ContType := ctCatExplanation;
              NextItem.ItemIndex := CurrItem.ItemIndex;
              NextItem.SelStart := -1;
              Result := True;
            end
          else
            begin
//Are there annotations? If so, return the ann text of the last...
              if IMTAnnList.Count > 0 then
                begin
                  NextItem.ContType := ctAnnText;
                  NextItem.ItemIndex := IMTAnnList.Count-1;
                  NextItem.SelStart := Length(IMTAnnList.AnnText[IMTAnnList.Count-1]);
                  Result := True;
                end
              else
                begin
//Otherwise, return ctHeader.
                  NextItem.ContType := ctHeader;
                  NextItem.ItemIndex := -1;
                  NextItem.SelStart := Length(wsTeiHeader);
                  Result := True;
                end;
            end;
        end;
      ctCatExplanation:
        begin
          if Down then
            begin
//Are there subsequent categories? If so, return the cat id of the next.
              if CurrItem.ItemIndex < (AnnCatList.Count-1) then
                begin
                  NextItem.ContType := ctCatId;
                  NextItem.ItemIndex := CurrItem.ItemIndex + 1;
                  NextItem.SelStart := -1;
                  Result := True;
                end
//Otherwise, are we wrapping around? If so, return ctHeader...
              else
                begin
                  if Wraparound then
                    begin
                      NextItem.ContType := ctHeader;
                      NextItem.ItemIndex := -1;
                      NextItem.SelStart := -1;
                      Result := True;
                    end;
                end;
//If not, return ctNone.
            end
          else
            begin
//Return the cat id of the current category.
              NextItem.ContType := ctCatId;
              NextItem.ItemIndex := CurrItem.ItemIndex;
              NextItem.SelStart := Length(AnnCatList.ID[CurrItem.ItemIndex]);
              Result := True;
            end;
        end;
    end;
  end;

  function GetTextToSearch(CurrItem: TIMTSelection): WideString;
  begin
    Result := '';
    Case CurrItem.ContType of
      ctHeader: Result := WideTrim(wsTeiHeader);
      ctAnnTitle: Result := IMTAnnList.AnnTitle[CurrItem.ItemIndex];
      ctAnnText: Result := IMTAnnList.AnnText[CurrItem.ItemIndex];
      ctCatId: Result := AnnCatList.ID[CurrItem.ItemIndex];
      ctCatExplanation: Result := AnnCatList.Explanation[CurrItem.ItemIndex];
    end;
  end;

  function HitFoundInContainer(StartFrom: TIMTSelection): Boolean;
  var
  wsDummy: WideString;
  i: integer;

  begin
    Result := False; //default; no suitable hit.
    //Set up the search list for use
    SearchList.ClearAll;
    //Search the container
    SearchList.SearchContainer(StartFrom.ContType, StartFrom.ItemIndex,
                                         MatchCase, WholeWordOnly, SearchFor,
                                         GetTextToSearch(StartFrom), '', False,
                                         wsDummy);
//If there are any hits, we need to work through to see if they're on the right
//side of the starting point.
  if SearchList.Count > 0 then
    begin
      if Down then
        begin
          for i := 0 to SearchList.Count-1 do
            if TIMTSelection(SearchList[i]).SelStart > StartFrom.SelStart then
              begin
                FoundHit.ContType := StartFrom.ContType;
                FoundHit.ItemIndex := StartFrom.ItemIndex;
                FoundHit.SelStart := TIMTSelection(SearchList[i]).SelStart;
                FoundHit.SelLength := TIMTSelection(SearchList[i]).SelLength;
                FoundHit.SelText := TIMTSelection(SearchList[i]).SelText;
                Result := True;
                Break;
              end;
        end
      else
        begin
          for i := SearchList.Count-1 downto 0 do
            if TIMTSelection(SearchList[i]).SelStart < StartFrom.SelStart then
              begin
                FoundHit.ContType := StartFrom.ContType;
                FoundHit.ItemIndex := StartFrom.ItemIndex;
                FoundHit.SelStart := TIMTSelection(SearchList[i]).SelStart;
                FoundHit.SelLength := TIMTSelection(SearchList[i]).SelLength;
                FoundHit.SelText := TIMTSelection(SearchList[i]).SelText;
                Result := True;
                Break;
              end;
        end;
    end;
  end;

var
StartFromIsOK: Boolean;
TempSel: TIMTSelection;
NextItem: TIMTSelection;
i: integer;
Looped: Boolean;

begin
  Result := False; //default return: no hit found.

  NextItem := TIMTSelection.Create;
  TempSel := TIMTSelection.Create;
  try

    Application.ProcessMessages;

  //First a sanity check:
    StartFromIsOK := True;
  //Check that the item referenced actually exists.
    Case StartFrom.ContType of
      ctAnnTitle, ctAnnText:
        if not (StartFrom.ItemIndex in [0..IMTAnnList.Count-1]) then
          StartFromIsOK := False;
      ctCatId, ctCatExplanation:
        if not (StartFrom.ItemIndex in [0..AnnCatList.Count-1]) then
          StartFromIsOK := False;
    end;

    Application.ProcessMessages;

  //If we're not starting from a sane location, then
    if StartFromIsOK = False then
      if Down then
  //let's start from the top of the document if working down, or
        begin
          StartFrom.ContType := ctHeader;
          StartFrom.ItemIndex := -1;
          StartFrom.SelStart := -1;
          Application.ProcessMessages;
        end
      else
        begin
          if AnnCatList.Count > 0 then
            begin
              StartFrom.ContType := ctCatExplanation;
              StartFrom.ItemIndex := AnnCatList.Count-1;
              StartFrom.SelStart := Length(AnnCatList.Explanation[AnnCatList.Count-1]);
            end
          else
            begin
              if IMTAnnList.Count > 0 then
                begin
                  StartFrom.ContType := ctAnnText;
                  StartFrom.ItemIndex := IMTAnnList.Count-1;
                  StartFrom.SelStart := Length(IMTAnnList.AnnText[IMTAnnList.Count-1]);
                end
              else
                begin
                  StartFrom.ContType := ctHeader;
                  StartFrom.ItemIndex := -1;
                  StartFrom.SelStart := Length(wsTeiHeader);
                end;
            end;
          Application.ProcessMessages;
        end;


  //First, search the current container. If we have a hit there,
  //we don't need to do anything else.
    Result := HitFoundInContainer(StartFrom);
    if Result then
      Exit
    else
      begin
        if GetNextItem(StartFrom, NextItem) = False then
          Exit;
        Looped := False;
        while (Result = False) and (Looped = False) do
          begin
            Result := HitFoundInContainer(NextItem);
  //Now we keep getting the next container until we hit ctNone, or come back to
  //where we started.
            if Result = False then
              begin
  //Is this the same as the starting container?
                if ((NextItem.ContType = StartFrom.ContType) and
                    (NextItem.ItemIndex = StartFrom.ItemIndex)) then
                  Looped := True
                else
                  begin
                    TempSel.ContType := NextItem.ContType;
                    TempSel.ItemIndex := NextItem.ItemIndex;
                    TempSel.SelStart := NextItem.SelStart;
                    if GetNextItem(TempSel, NextItem) = False then
                      Looped := True;
                  end;
              end;
          end;
      end;
  finally
    FreeAndNil(TempSel);
    FreeAndNil(NextItem);
  end;
end;

function TIMTDoc.GetKWICDisplay(Sel: TIMTSelection; PadChars: integer): WideString;
{This embedded function actually extracts the block of text required, from the
 source text, based on the number of padding characters specified, and not
 running over line-ends.}
  function GetKWIC(wsText: WideString; Start, Len: integer) : WideString;
  var
  FromPos, ToPos: integer;
  begin
    FromPos := Start;
    while ((not (wsText[FromPos] in [#13, #10])) and (Start-FromPos < PadChars))
          and (FromPos > 1) do
      dec(FromPos);
    ToPos := Start + Len;
    while ((not (wsText[ToPos] in [#13, #10])) and (ToPos - (Start+Len) < PadChars))
          and (ToPos < Length(wsText)) do
      inc(ToPos);
    Result := Copy(wsText, FromPos, ToPos-FromPos);
  end;

var
containerText: WideString;

begin
//TODO: Finish this function!

  Result := ''; //Default
//First, we need to find the container, and check it exists and contains text.
  Case Sel.ContType of
    ctNone: Exit;
    ctHeader: containerText := WideTrim(wsTeiHeader);
    ctAnnTitle: containerText := IMTAnnList.AnnTitle[Sel.ItemIndex];
    ctAnnText: containerText := IMTAnnList.AnnText[Sel.ItemIndex];
    ctCatId: containerText := AnnCatList.ID[Sel.ItemIndex];
    ctCatExplanation: containerText := AnnCatList.Explanation[Sel.ItemIndex];
  end;

  Result := GetKWIC(containerText, Sel.SelStart+1, Sel.SelLength);
end;

end.