builder.pas

支持自定义语法高亮显示的编辑器控件

{--------------------------------------------}

procedure TfrmBuilder.tvSchemeChange(Sender: TObject; Node: TTreeNode);
begin
  UpdateSchemePopup;
  UpdatePanels;
end;

{--------------------------------------------}

procedure TfrmBuilder.btClearClick(Sender: TObject);
begin
  ClearScheme;
end;

{--------------------------------------------}

procedure TfrmBuilder.ClearScheme;
begin
  Scheme.Language := '';
  Scheme.Copyright := '';
  Scheme.WWW := '';
  Scheme.EMail := '';
  Scheme.Delimiters := '';
  Scheme.States.Clear;
  Scheme.Tokens.Clear;
  ClearProperties;
end;

{--------------------------------------------}

function TfrmBuilder.GetNodeKind: TNodeKind;
begin
  result := nkNone;
  if tvScheme.Selected = nil then
    exit;
  case tvScheme.Selected.Level of
    0 : result := nkGeneral;
    1 :
      begin
        if CompareText(tvScheme.Selected.Text, sStates) = 0 then
          result := nkStates
        else
        if CompareText(tvScheme.Selected.Text, sTokens) = 0 then
          result := nkTokens;
      end;
    2 :
      begin
        if CompareText(tvScheme.Selected.Parent.Text, sStates) = 0 then
          result := nkState
        else
        if CompareText(tvScheme.Selected.Parent.Text, sTokens) = 0 then
          result := nkToken;
      end;
    3 :
      begin
        if CompareText(tvScheme.Selected.Text, sBlocks) = 0 then
          result := nkBlocks
        else
        if CompareText(tvScheme.Selected.Text, sReswords) = 0 then
          result := nkReswords;
      end;
     4 :
       begin
        if CompareText(tvScheme.Selected.Parent.Text, sBlocks) = 0 then
          result := nkBlock
        else
        if CompareText(tvScheme.Selected.Parent.Text, sReswords) = 0 then
          result := nkResword;
       end;
  end;
end;

{--------------------------------------------}

procedure TfrmBuilder.UpdateSchemePopup;
var
  kind      : TNodeKind;
  menuItem1 : TMenuItem;
  menuItem2 : TMenuItem;
begin
  kind := GetNodeKind;
  menuItem1 := TMenuItem.Create(PopupMenu1);
  menuItem2 := TMenuItem.Create(PopupMenu1);
  PopupMenu1.Items.Clear;
  case kind of
    nkState:
      begin
        PopupMenu1.Items.Add(menuItem1);
        PopupMenu1.Items.Add(menuItem2);
        menuItem1.Caption := sAddState;
        menuItem2.Caption := sDeleteState;
        menuItem1.Action := AddState;
        menuItem2.Action := DeleteState;
        menuItem2.Enabled := not IsStateUsed;
      end;
    nkStates:
      begin
        PopupMenu1.Items.Add(menuItem1);
        menuItem1.Caption := sAddState;
        menuItem1.Action := AddState;
      end;
    nkToken:
      begin
        PopupMenu1.Items.Add(menuItem1);
        PopupMenu1.Items.Add(menuItem2);
        menuItem1.Caption := sAddToken;
        menuItem2.Caption := sDeleteToken;
        menuItem1.Action := AddToken;
        menuItem2.Action := DeleteToken;
        menuItem2.Enabled := not IsTokenUsed;
      end;
    nkTokens:
      begin
        PopupMenu1.Items.Add(menuItem1);
        menuItem1.Caption := sAddToken;
        menuItem1.Action := AddToken;
      end;
    nkBlock:
      begin
        PopupMenu1.Items.Add(menuItem1);
        PopupMenu1.Items.Add(menuItem2);
        menuItem1.Caption := sAddBlock;
        menuItem2.Caption := sDeleteBlock;
        menuItem1.Action := AddBlock;
        menuItem2.Action := DeleteBlock;
      end;
    nkBlocks:
      begin
        PopupMenu1.Items.Add(menuItem1);
        menuItem1.Caption := sAddBlock;
        menuItem1.Action := AddBlock;
      end;
  end;
end;

{--------------------------------------------}

procedure TfrmBuilder.AddTokenExecute(Sender: TObject);
var
  node : TTreeNode;
  i    : integer;
begin
  node := GetNode(nkTokens);
  if node = nil then
    Exit;
  i := GetNewNumberFromNode(node, sNewToken);
  node := tvScheme.Items.AddChild(node, sNewToken + IntToStr(i));
  node.ImageIndex := - 1;
  node.SelectedIndex := cPropIndex;
  UpdateTokens;
  tvScheme.Selected := node;  
end;

{--------------------------------------------}

procedure TfrmBuilder.DeleteTokenExecute(Sender: TObject);
var
  index : integer;
  node  : TTreeNode;
begin
  index := tvScheme.Selected.Index;
  node := GetNode(nkTokens);
  tvScheme.Items.Delete(tvScheme.Selected);
  index := Min(index, node.Count - 1);
  if index >= 0 then
    tvScheme.Selected := node.Item[index];
  UpdateTokens;
end;

{--------------------------------------------}

procedure TfrmBuilder.AddStateExecute(Sender: TObject);
var
  node : TTreeNode;
  i    : integer;
begin
  node := GetNode(nkStates);
  if node = nil then
    exit;
  i := GetNewNumberFromNode(node, sNewState);
  node := tvScheme.Items.AddChild(node, sNewState + IntToStr(i));
  tvScheme.Items.AddChild(node, sBlocks);
  with tvScheme.Items.AddChild(node, sReswords) do
  begin
    ImageIndex := - 1;
    SelectedIndex := cPropIndex;
  end;
  UpdateStates;
  tvScheme.Selected := node;
end;

{--------------------------------------------}

procedure TfrmBuilder.DeleteStateExecute(Sender: TObject);
var
  index : integer;
  node  : TTreeNode;
begin
  index := tvScheme.Selected.Index;
  node := GetNode(nkStates);
  tvScheme.Items.Delete(tvScheme.Selected);
  index := Min(index, node.Count - 1);
  if index >= 0 then
    tvScheme.Selected := node.Item[index];
  UpdateStates;
end;

{--------------------------------------------}

procedure TfrmBuilder.AddBlockExecute(Sender: TObject);
var
  node : TTreeNode;
  i    : integer;
begin
  node := GetNode(nkBlocks);
  if node = nil then
    Exit;
  i := GetNewNumberFromNode(node, sNewBlock);
  node := tvScheme.Items.AddChild(node, sNewBlock + IntToStr(i));
  node.ImageIndex := - 1;
  node.SelectedIndex := cPropIndex;
  tvScheme.Selected := node;
  UpdateBlocks;
end;

{--------------------------------------------}

procedure TfrmBuilder.DeleteBlockExecute(Sender: TObject);
var
  node  : TTreeNode;
  index : integer;
begin
  index := tvScheme.Selected.Index;
  node := GetNode(nkBlocks);
  tvScheme.Items.Delete(tvScheme.Selected);
  index := Min(index, node.Count - 1);
  if index >= 0 then
    tvScheme.Selected := node.Item[index];
  UpdateBlocks;
end;

{--------------------------------------------}

function TfrmBuilder.GetNode(AKind: TNodeKind): TTreeNode;
begin
  result := nil;
  case AKind of
  nkStates:
    begin
      result := tvScheme.Items[0].getFirstChild;
      result := result.getNextSibling;
    end;
  nkTokens:
    begin
      result := tvScheme.Items[0].getFirstChild;
    end;
  nkBlocks:
    begin
      if (tvScheme.Selected = nil) or (tvScheme.Selected.Level < 2) then
        exit;
      if tvScheme.Selected.Level = 2 then
        result := tvScheme.Selected;
      if tvScheme.Selected.Level = 3 then
        result := tvScheme.Selected.Parent;
      if tvScheme.Selected.Level = 4 then
        result := tvScheme.Selected.Parent.Parent;
      if CompareText(result.Parent.Text, sStates) <> 0 then
        begin
          result := nil;
          exit;
        end;
      result := result.getFirstChild;
    end;
    nkReswords:
      begin
        if (tvScheme.Selected = nil) or (tvScheme.Selected.Level < 2) then
          exit;
        if tvScheme.Selected.Level = 2 then
            result := tvScheme.Selected;
        if tvScheme.Selected.Level = 3 then
            result := tvScheme.Selected.Parent;
        if tvScheme.Selected.Level = 4 then
            result := tvScheme.Selected.Parent.Parent;
        if CompareText(result.Parent.Text, sStates) <> 0 then
        begin
          result := nil;
          exit;
        end;
        result := result.getFirstChild;
        result := result.getNextSibling;
      end;
  end;
end;

{--------------------------------------------}

procedure TfrmBuilder.SetCurrentPanel(Value : TPanel);
var
  i : integer;
begin
  if Value = nil then
    Exit;
  for i := 0 to pnMain.ControlCount - 1 do
    pnMain.Controls[i].Visible := false;
  with Value do
  begin
    Visible := true;
    Parent := pnMain;
    Align := alClient;
    BringToFront;
  end;
end;

{--------------------------------------------}

procedure TfrmBuilder.UpdatePanels;
var
  kind  : TNodeKind;
  panel : TPanel;
begin
  kind := GetNodeKind;
  panel := nil;
  case kind of
    nkGeneral:
      begin
        panel := pnGeneral;
        UpdateGeneralPanel;
      end;
    nkState, nkBlocks:
      begin
        panel := pnState;
        pnResword.Align := alNone;
        pnBlock.Align := alNone;
        pnResword.Visible := false;
        pnBlock.Visible := false;
        UpdateStatePanel;
      end;
    nkReswords:
      begin
        panel := pnState;
        pnResword.Align := alClient;
        pnBlock.Align := alNone;
        pnResword.Visible := true;
        pnBlock.Visible := false;
        UpdateReswordPanel;
      end;
    nkToken:
      begin
        panel := pnToken;
        UpdateTokenPanel;
      end;
    nkBlock:
      begin
        panel := pnState;
        pnResword.Align := alNone;
        pnBlock.Align := alClient;
        pnResword.Visible := false;
        pnBlock.Visible := true;
        UpdateBlockPanel;
      end;
  end;
  SetCurrentPanel(panel);
end;

{--------------------------------------------}

procedure TfrmBuilder.FormShow(Sender: TObject);
begin
  tvScheme.Selected := tvScheme.Items[0];
  tvScheme.SetFocus;
end;

{--------------------------------------------}

procedure TfrmBuilder.UpdateBlockPanel;
begin
  FUpdating := true;
  UpdateStatePanel;
  if tvScheme.Selected <> nil then
    edBlockName.Text := tvScheme.Selected.Text
  else
    edBlockName.Text := '';
  UpdateExprPanel;
  FUpdating := false;
end;

{--------------------------------------------}

procedure TfrmBuilder.UpdateReswordPanel;
var
  i       : integer;
  state   : TSchemeState;
begin
  FUpdating := true;
  UpdateStatePanel;
  lbReswords.Clear;
  state := GetState;
  if (state = nil) then
    Exit;
  for i := 0 to state.Reswords.Count - 1 do
    lbReswords.Items.Add(state.Reswords[i].Expression);
  if lbReswords.Items.Count > 0 then
    lbReswords.ItemIndex := 0;
  UpdateReswordProp;
  FUpdating := false;
end;

{--------------------------------------------}

procedure TfrmBuilder.UpdateStatePanel;
var
  state : TSchemeState;
begin
  state := GetState;
  if state <> nil then
  begin
    edStateName.Text := state.Name;
    chbStateCaseSensitive.Checked := state.CaseSensitive;
  end
  else
  begin
    edStateName.Text := '';
    chbStateCaseSensitive.Checked := false;
  end;
end;

{--------------------------------------------}

procedure TfrmBuilder.UpdateTokenPanel;
begin
  if tvScheme.Selected <> nil then
    edTokenName.Text := tvScheme.Selected.Text
  else
    edTokenName.Text := '';
end;

{--------------------------------------------}

procedure TfrmBuilder.UpdateStates;
var
  i         : integer;
  childNode : TTreeNode;
  node      : TTreeNode;
begin
  node := GetNode(nkStates);
  childNode := node.getFirstChild;
  while childNode <> nil do
  begin
    if childNode.Index < Scheme.States.Count then
      Scheme.States[childNode.Index].Name := childNode.Text
    else
      Scheme.States.Add(childNode.Text, GetCaseSensitive);
    childNode := childNode.getNextSibling;
  end;
  childNode := node.GetLastChild;
  if childNode.Index < Scheme.States.Count - 1 then
    for i := childNode.Index + 1 to Scheme.States.Count - 1 do
      Scheme.States.Delete(i);
  UpdateStateControls;
end;

{--------------------------------------------}

procedure TfrmBuilder.UpdateTokens;
var
  childNode : TTreeNode;
  node      : TTreeNode;
begin
  node := GetNode(nkTokens);
  childNode := node.getFirstChild;
  Scheme.Tokens.Clear;
  while childNode <> nil do
    begin
      Scheme.Tokens.Add(childNode.Text);
      childNode := childNode.getNextSibling;
    end;
  UpdateTokenControls;
  if node.Count > 0 then
    node.Expand(true);
end;

{--------------------------------------------}

procedure TfrmBuilder.UpdateBlocks;
var
  i         : integer;
  childNode : TTreeNode;
  node      : TTreeNode;
begin
  node := GetNode(nkBlocks);
  if (node = nil) or (node.Index >= Scheme.States.Count) then
    exit;
  childNode := node.getFirstChild;
  while childNode <> nil do
  begin
    if childNode.Index < Scheme.States[node.Parent.Index].Blocks.Count then
      Scheme.States[node.Parent.Index].Blocks[childNode.Index] := childNode.Text
    else
      Scheme.States[node.Parent.Index].AddBlock(childNode.Text);
    childNode := childNode.getNextSibling;
  end;
  childNode := node.GetLastChild;
  if childNode.Index < Scheme.States[node.Index].Blocks.Count - 1 then
    for i := childNode.Index + 1 to Scheme.States[node.Index].Blocks.Count - 1 do