builder.pas.svn-base

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

      Scheme.States[node.Index].DeleteBlock(i);
  node.Expand(true);
end;

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

function TfrmBuilder.GetNewNumberFromNode(ANode: TTreeNode; AName: string): integer;
var
  i : integer;
  s : TStringList;
begin
  s := TStringList.Create;
  for i := 0 to ANode.Count - 1 do
    s.Add(ANode.Item[i].Text);
  result := GetNewNumber(s, AName);
end;

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

function TfrmBuilder.GetNewNumber(ANames: TStrings; AName: string): integer;
var
  p    : integer;
  i    : integer;
  j    : integer;
  s    : TStringList;
  ss   : string;
  sss  : string;
begin
  s := TStringList.Create;
  try
    for i := 0 to ANames.Count - 1 do
    begin
      p := Pos(AName, ANames[i]);
      if p > 0 then
      begin
        ss := Trim(Copy(ANames[i], p + Length(AName), Length(ANames[i])));
        sss := '';
        for j := 1 to Length(ss) do
          begin
            if (Ord(ss[j]) >= 48) and (Ord(ss[j]) <= 57) then
              sss := sss + ss[j]
            else
              break;
          end;
          if sss <> '' then
            s.Add(sss);
      end;
    end;
    s.Sorted := true;
    result := 1;
    for i := 0 to s.Count - 1 do
    begin
      if result = StrToInt(s[i]) then
        result := result + 1
      else
        Break;
    end;
  finally
    S.Free;
  end;
end;

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

procedure TfrmBuilder.edLanguageKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then
    Scheme.Language := edLanguage.Text;
end;

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

procedure TfrmBuilder.edCopyrightKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then
    Scheme.Copyright := edCopyright.Text;
end;

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

procedure TfrmBuilder.UpdateTreeview;
var
  i         : integer;
  j         : integer;
  node      : TTreeNode;
  childNode : TTreeNode;
begin
  tvScheme.Items.BeginUpdate;
  try
    node := GetNode(nkTokens);
    node.DeleteChildren;
    for i := 0 to Scheme.Tokens.Count - 1 do
      with tvScheme.Items.AddChild(node, Scheme.Tokens[i]) do
      begin
        ImageIndex := - 1;
        SelectedIndex := cPropIndex;
      end;
    UpdateNodeIndex(node);
    node := GetNode(nkStates);
    node.DeleteChildren;
    for i := 0 to Scheme.States.Count - 1 do
    begin
      childNode := tvScheme.Items.AddChild(node, Scheme.States[i].Name);
      tvScheme.Items.AddChild(childNode, sBlocks);
      with tvScheme.Items.AddChild(childNode, sReswords) do
      begin
        ImageIndex := - 1;
        SelectedIndex := cPropIndex;
      end;
      for j := 0 to Scheme.States[i].Blocks.Count - 1 do
        with tvScheme.Items.AddChild(childNode.getFirstChild, Scheme.States[i].Blocks[j]) do
        begin
          ImageIndex := - 1;
          SelectedIndex := cPropIndex;
        end;
    end;
    UpdateNodeIndex(node);
    tvScheme.Selected := tvScheme.Items[0];
  finally
    tvScheme.Items.EndUpdate;
  end;
end;

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

procedure TfrmBuilder.WriteScheme(s : TStrings);
var
  i     : integer;
  j     : integer;
  k     : integer;
  expr  : TSchemeExpressions;
begin
  if Scheme.Language <> '' then
    s.Add(sComment + sLanguage + ': ' + Scheme.Language);
  if Scheme.Copyright <> '' then
    s.Add(sComment + sCopyright + ' ' + Scheme.Copyright);
  if Scheme.WWW <> '' then
    s.Add(sComment + Scheme.WWW);
  if Scheme.EMail <> '' then
    s.Add(sComment + Scheme.EMail);
  if Scheme.States.Count > 0 then
  begin
    s.Add(' ');
    s.Add(sComment + ' ' + sStates);
    for i := 0 to Scheme.States.Count - 1 do
      begin
        if i = 0 then
          s.Add(sState + '=' + Scheme.States[i].Name + ',' + sCaseSensitive)
        else
          s.Add(sState + '=' + Scheme.States[i].Name);
      end;
  end;
  if Scheme.Tokens.Count > 0 then
  begin
    s.Add(' ');
    s.Add(sComment + '  ' + sTokens);
    for i := 0 to Scheme.Tokens.Count - 1 do
      s.Add(sToken + '=' + Scheme.Tokens[i]);
  end;
  if Scheme.Delimiters <> '' then
  begin
    s.Add(' ');
    s.Add(sComment + sDelims);
    s.Add(sDelimiters + '=' + Scheme.Delimiters);
  end;
  for i := 0 to Scheme.States.Count - 1 do
  begin
    if Scheme.States[i].Reswords.Count > 0 then
      begin
        s.Add(' ');
        s.Add(sComment + ' ' +  sReswords);
        for
        j := 0 to Scheme.States[i].Reswords.Count - 1 do
          s.Add(Scheme.States[i].Name + ' ''' + Scheme.States[i].Reswords[j].Expression +
           ''' ' + Scheme.States[i].Reswords[j].State + ' ' + Scheme.States[i].Reswords[j].Token);
      end;
      for j := 0 to Scheme.States[i].Blocks.Count - 1 do
        begin
          s.Add(' ');
          s.Add(sComment + ' ' + Scheme.States[i].Blocks.Strings[j]);
          expr := TSchemeExpressions(Scheme.States[i].Blocks.Objects[j]);
          for k := 0 to expr.Count - 1 do
            s.Add(Scheme.States[i].Name + ' ' + expr[k].Expression + ' ' +
             expr[k].State + ' ' + expr[k].Token);
        end;
  end;
end;

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

procedure TfrmBuilder.ReadScheme;
var
  i          : integer;
  j          : integer;
  state      : TEasyParserState;
  s          : TStrings;
  expr       : TEasyParserRegExpr;
  SchemeExpr : TSchemeExpressions;
  exprItem   : TSchemeExpression;
begin
  ClearScheme;
  Scheme.Tokens.Assign(EasyEditorParser1.Tokens);
  for i := 0 to EasyEditorParser1.States.Count - 1 do
    Scheme.States.Add(EasyEditorParser1.States[i], false);
  Scheme.Delimiters := EasyEditorParser1.Delimiters;
  Scheme.CaseSensitive := EasyEditorParser1.CaseSensitive;
  Scheme.Language := EasyEditorParser1.Language;
  Scheme.Copyright := EasyEditorParser1.Copyright;
  Scheme.WWW := EasyEditorParser1.WWW;
  Scheme.EMail := EasyEditorParser1.EMail;
  for i := 0 to EasyEditorParser1.States.Count - 1 do
    begin
      state := EasyEditorParser1.GetParserState(i);
      s := TStringList.Create;
      try
        state.GetResWords(s);
        for j := 0 to s.Count - 1 do
          begin
            exprItem := Scheme.States[i].Reswords.Add(s[j]);
            exprItem.State := EasyEditorParser1.States[TEasyRule(s.Objects[j]).State];
            exprItem.Token := EasyEditorParser1.Tokens[TEasyRule(s.Objects[j]).Token];
          end;
        state.GetExpressions(s);
        for j := 0 to state.Blocks.Count - 1 do
          Scheme.States[i].AddBlock(state.Blocks[j]);
        for j := 0 to s.Count - 1 do
        begin
          expr := TEasyParserRegExpr(s.Objects[j]);
          if expr.Block >= 0 then
          begin
            SchemeExpr := TSchemeExpressions(Scheme.States[i].Blocks.Objects[expr.Block]);
            exprItem := SchemeExpr.Add(s[j]);
            exprItem.State := EasyEditorParser1.States[expr.Rule.State];
            exprItem.Token := EasyEditorParser1.Tokens[expr.Rule.Token];
          end;
        end;
      finally
        s.Free;
      end;
    end;
end;

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

procedure TfrmBuilder.AddExpression1Click(Sender: TObject);
begin
  AddExpression('');
end;

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

procedure TfrmBuilder.UpdateExprPanel;
var
  i    : integer;
  expr : TSchemeExpressions;
begin
  lbExpressions.Clear;
  expr := GetBlockExpressions;
  if expr <> nil then
    for i := 0 to expr.Count - 1 do
      lbExpressions.Items.Add(expr.Items[i].Expression);
  lbExpressions.ItemIndex := Min(lbExpressions.Items.Count - 1, 0);
  UpdateExprProp;
end;

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

procedure TfrmBuilder.DeleteExpression1Click(Sender: TObject);
begin
  DeleteExpression;
end;

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

function TfrmBuilder.GetResword: TSchemeExpression;
var
  state : TSchemeState;
begin
  result := nil;
  state := GetState;
  if ((state = nil) or (lbReswords.ItemIndex < 0) or (state.Reswords.Count <= lbReswords.ItemIndex)) then
    Exit;
  result := state.Reswords[lbReswords.ItemIndex];
end;

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

function TfrmBuilder.GetState: TSchemeState;
var
  kind : TNodeKind;
begin
  result := nil;
  kind := GetNodeKind;
  case kind of
    nkState: result := Scheme.States[tvScheme.Selected.Index];
    nkBlocks: result := Scheme.States[tvScheme.Selected.Parent.Index];
    nkReswords: result := Scheme.States[tvScheme.Selected.Parent.Index];
    nkBlock: result := Scheme.States[tvScheme.Selected.Parent.Parent.Index];
    nkResword: result := Scheme.States[tvScheme.Selected.Parent.Parent.Index];
  end;
end;

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

function TfrmBuilder.GetBlockNumber: integer;
var
  kind  : TNodeKind;
  state : TSchemeState;
begin
  result := -1;
  kind := GetNodeKind;
  state := GetState;
  if (kind <> nkBlock) or (state = nil) or (tvScheme.Selected.Index >= state.Blocks.Count) then
    Exit;
  result := tvScheme.Selected.Index;
end;

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

function TfrmBuilder.GetBlockExpressions: TSchemeExpressions;
var
  kind  : TNodeKind;
  state : TSchemeState;
begin
  result := nil;
  kind := GetNodeKind;
  state := GetState;
  if (kind <> nkBlock) or (state = nil) or (tvScheme.Selected.Index >= state.Blocks.Count) then
    Exit;
  result := TSchemeExpressions(state.Blocks.Objects[tvScheme.Selected.Index]);
end;

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

function TfrmBuilder.GetExpression: TSchemeExpression;
var
  expr : TSchemeExpressions;
begin
  result := nil;
  expr := GetBlockExpressions;
  if (expr = nil) or (lbExpressions.ItemIndex < 0) then
    Exit;
  result := expr[lbExpressions.ItemIndex];
end;

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

procedure TfrmBuilder.UpdateExprProp;
var
  expr : TSchemeExpression;
begin
  expr := GetExpression;
  if expr <> nil then
  begin
    gbExpressionProperties.Enabled := true;
    cbState.ItemIndex :=
      cbState.Items.IndexOf(expr.State);
    cbToken.ItemIndex :=
      cbToken.Items.IndexOf(expr.Token);
    cbExpressions.Text := expr.Expression;
  end
  else
  begin
    gbExpressionProperties.Enabled := false;
    cbState.ItemIndex := - 1;
    cbToken.ItemIndex := - 1;
    cbExpressions.Text := '';
  end;
end;

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

procedure TfrmBuilder.AddExpression(const Value: string);
var
  node     : TTreeNode;
  i        : integer;
  expr     : TSchemeExpressions;
  exprName : string;
begin
  node := GetNode(nkBlocks);
  i := GetNewNumber(lbExpressions.Items, sNewExpression);
  expr := TSchemeExpressions(Scheme.States[node.Parent.Index].Blocks.Objects[tvScheme.Selected.Index]);
  if Value <> '' then
    exprName := Value
  else
    exprName := sNewExpression + IntToStr(i);
  expr.Add(exprName);
  lbExpressions.Items.Add(exprName);
  lbExpressions.ItemIndex := lbExpressions.Items.Count - 1;
  UpdateExprProp;
end;

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

procedure TfrmBuilder.DeleteExpression;
var
  expr  : TSchemeExpression;
  index : integer;
begin
  expr := GetExpression;
  if expr <> nil then
  begin
    expr.Free;
    index := lbExpressions.ItemIndex;
    lbExpressions.Items.Delete(index);
    index := Min(index, lbExpressions.Items.Count - 1);
    lbExpressions.ItemIndex := index;
    UpdateExprProp;
  end;
end;

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

procedure TfrmBuilder.UpdateStateControls;
var
  i : integer;
begin
  cbState.Clear;
  cbReswordState.Clear;
  for i := 0 to Scheme.States.Count - 1 do
  begin
    cbState.Items.Add(Scheme.States[i].Name);
    cbReswordState.Items.Add(Scheme.States[i].Name);
  end;
end;

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

procedure TfrmBuilder.UpdateTokenControls;
var
  i : integer;
begin
  cbToken.Clear;
  cbReswordToken.Clear;
  for i := 0 to Scheme.Tokens.Count - 1 do
  begin
    cbToken.Items.Add(Scheme.Tokens[i]);
    cbReswordToken.Items.Add(Scheme.Tokens[i]);
  end;
end;

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

procedure TfrmBuilder.edDelimitersKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then
    Scheme.Delimiters := edDelimiters.Text;
end;

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

procedure TfrmBuilder.edWWWKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then
    Scheme.WWW := edWWW.Text;
end;

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

procedure TfrmBuilder.edMailKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then
    Scheme.EMail := edMail.Text;
end;

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

function TfrmBuilder.IsStateUsed: boolean;
var
  i     : integer;
  j     : integer;
  k     : integer;
  state : TSchemeState;
  expr  : TSchemeExpressions;
begin
  result := false;
  state := GetState;
  if state = nil then
    exit;
  for i := 0 to Scheme.States.Count - 1 do
    begin
      if Scheme.States[i] = state then
        continue;
      for j := 0 to Scheme.States[i].Reswords.Count - 1 do
        if CompareText(Scheme.States[i].Reswords[j].State, state.Name) = 0 then
        begin
          result := true;
          exit;
        end;
      for j := 0 to Scheme.States[i].Blocks.Count - 1 do
      begin
        expr := TSchemeExpressions(Scheme.States[i].Blocks.Objects[j]);
        for k := 0 to expr.Count - 1 do
          if CompareText(expr[k].State, state.Name) = 0 then
          begin
            result := true;
            exit;
          end;
      end;
    end;