unit InsertTag;

{
[InsertTag] [1.0]
Delphi 2005
May 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 "[InsertTag.pas/InsertTag.dfm]".

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


The function of this form/unit is to provide a mechanism to enter XML tags and
get back tagged-up text. The user should be able to enter anything that
can form the content of an open tag:

  div
  hi rend="superscript"

and so on, and the unit then figures out how to tag up the text which is
supplied (if any) -- normally the selected text from a control -- and
then return the full open tag + text + closing tag to the calling function,
which is responsible for inserting it wherever it needs to go. This form
also maintains a list of recent values for tags, through FormState, in a
combo box.

Dependencies:

  FormState (Martin Holmes).

}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, TntForms, FormState, StdCtrls, TntStdCtrls, Buttons, TntButtons,
  jclUnicode;

type
  TufrmInsertTag = class(TTntForm)
    ubnOK: TTntBitBtn;
    ubnCancel: TTntBitBtn;
    ulbInsertTag: TTntLabel;
    ulbInsertTagExample1: TTntLabel;
    ulbInsertTagExample2: TTntLabel;
    ucmbInsertTag: TTntComboBox;
    procedure TntFormShow(Sender: TObject);
    procedure TntFormCreate(Sender: TObject);
    procedure TntFormDestroy(Sender: TObject);
  private
    { Private declarations }
    FFormStateSaver: TFormStateSaver;
    FItemsToRetain: integer;
  public
    { Public declarations }
    function GetTag(SelText: WideString): WideString;
//This is public because it may be handy in other contexts
    function CleanStartTag(wsInput: WideString): WideString;
    function GetCloseTag(wsOpenTag: WideString): WideString;

  published
    property ItemsToRetain: integer read FItemsToRetain write FItemsToRetain;
    
  end;

var
  ufrmInsertTag: TufrmInsertTag;

implementation

{$R *.DFM}

procedure TufrmInsertTag.TntFormDestroy(Sender: TObject);
begin
  FreeAndNil(FFormStateSaver);
end;

procedure TufrmInsertTag.TntFormCreate(Sender: TObject);
begin
  Icon := Application.Icon;
  ItemsToRetain := 16; //default
  FFormStateSaver := TFormStateSaver.Create(Self, True, True, True, True,
                                            True, True, True, True, False);
  while ucmbInsertTag.Items.Count > ItemsToRetain do
    ucmbInsertTag.Items.Delete(ucmbInsertTag.Items.Count-1);
end;

function TufrmInsertTag.GetTag(SelText: WideString): WideString;
var
OpenTag: WideString;
CloseTag: WideString;

begin
  Result := '';
  if ShowModal = mrOK then
    begin
//Bail if no useful input
      if Length(ucmbInsertTag.Text) < 1 then
        Exit;

//Get the open tag itself
      OpenTag := CleanStartTag(ucmbInsertTag.Text);

//Insert it into the list, or select it if it's already there
      if ucmbInsertTag.Items.IndexOf(OpenTag) > -1 then
        ucmbInsertTag.Items.Move(ucmbInsertTag.Items.IndexOf(OpenTag), 0)
      else
        ucmbInsertTag.Items.Insert(0, OpenTag);
      ucmbInsertTag.ItemIndex := 0;

//Create the close tag
      CloseTag := GetCloseTag(OpenTag);

//Complete the open tag with angle brackets
      OpenTag := '<' + OpenTag + '>';

//Return the complete tag
      Result := OpenTag + SelText + CloseTag;

    end
  else
    Result := SelText; //return the incoming text, so nothing can be screwed up.
end;

function TufrmInsertTag.CleanStartTag(wsInput: WideString): WideString;
var
i: integer;

begin
  Result := '';

//Get rid of leading and trailing spaces
  wsInput := WideTrim(wsInput);

//Get rid of anything following a close angle bracket
  i := Pos('>', wsInput);
  if i > 0 then
    wsInput := Copy(wsInput, 1, i-1);

//Remove any open angle brackets.
  wsInput := StringReplace(wsInput, '<', '', [rfReplaceAll]);

//Return whatever we have left, trimmed again.
  Result := WideTrim(wsInput);
end;

function TufrmInsertTag.GetCloseTag(wsOpenTag: WideString): WideString;
var
i: integer;
begin
//Remove any angle brackets
  wsOpenTag := StringReplace(wsOpenTag, '<', '', [rfReplaceAll]);
  wsOpenTag := StringReplace(wsOpenTag, '>', '', [rfReplaceAll]);
  i := Pos(' ', wsOpenTag);
  if i > 0 then
    Result := '</' + Copy(wsOpenTag, 1, i-1) + '>'
  else
    Result := '</' + wsOpenTag + '>';
end;

procedure TufrmInsertTag.TntFormShow(Sender: TObject);
begin
  ucmbInsertTag.SetFocus;
end;

end.