unit IdentForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.ComCtrls, ASKernelDefs, ASKernel, ASObjects, ASObjStore, Vcl.Menus,
  UITypes, ListViewEx;

type
  TIdentFrm = class(TForm)
    lvIdents: TListViewEx;
    pmIdents: TPopupMenu;
    mnuOpen: TMenuItem;
    mnuInsert: TMenuItem;
    mnuDelete: TMenuItem;
    smnuCopyValue: TMenuItem;
    mnuCopyValueMultiline: TMenuItem;
    mnuCopyValueSingleLine: TMenuItem;
    mnuCopyValueTruncatedSingleLine: TMenuItem;
    mnuCopyValueInputForm: TMenuItem;
    mnuCopyValueDefault: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    mnuCopyValueUnformatted: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    mnuCopyName: TMenuItem;
    mnuShowVariables: TMenuItem;
    mnuShowKernelFunctions: TMenuItem;
    mnuShowOperators: TMenuItem;
    N5: TMenuItem;
    mnuHideSystem: TMenuItem;
    mnuSaveAs: TMenuItem;
    StatusBar: TStatusBar;
    mnuRename: TMenuItem;
    procedure lvIdentsDblClick(Sender: TObject);
    procedure mnuOpenClick(Sender: TObject);
    procedure lvIdentsKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure mnuInsertClick(Sender: TObject);
    procedure mnuDeleteClick(Sender: TObject);
    procedure lvIdentsKeyPress(Sender: TObject; var Key: Char);
    procedure CopyValueFmt(Sender: TObject); overload;
    procedure pmIdentsPopup(Sender: TObject);
    procedure mnuCopyNameClick(Sender: TObject);
    procedure mnuShowVariablesClick(Sender: TObject);
    procedure mnuShowKernelFunctionsClick(Sender: TObject);
    procedure mnuShowOperatorsClick(Sender: TObject);
    procedure lvIdentsData(Sender: TObject; Item: TListItem);
    procedure mnuHideSystemClick(Sender: TObject);
    procedure mnuSaveAsClick(Sender: TObject);
    procedure mnuRenameClick(Sender: TObject);
  private
    FKernel: TASKernel;
    FIdents: TArray<TASKernel.TIdentInfo>;
    procedure OpenVar;
    procedure DeleteVars;
    procedure CopyValueFmt(AFormat: Integer); overload;
    function GetSelectedIndices: TArray<Integer>;
  public
    procedure UpdateIdents(AKernel: TASKernel);
  end;

var
  IdentFrm: TIdentFrm;

implementation

{$R *.dfm}

uses
  Math, Gallery, MainForm, TextEditor, CommCtrl, Generics.Defaults,
  Generics.Collections, TableDialog, Clipbrd, ASTokenizer, TDMB,
  MultiInput;

procedure TIdentFrm.mnuCopyNameClick(Sender: TObject);
begin

  if lvIdents.SelCount <> 1 then
    Exit;

  if lvIdents.ItemIndex = -1 then
    Exit;

  if not InRange(lvIdents.ItemIndex, 0, High(FIdents)) then
    Exit;

  Clipboard.AsText := FIdents[lvIdents.ItemIndex].Name;

end;

procedure TIdentFrm.mnuDeleteClick(Sender: TObject);
begin
  DeleteVars;
end;

procedure TIdentFrm.mnuHideSystemClick(Sender: TObject);
begin
  UpdateIdents(FKernel);
end;

procedure TIdentFrm.mnuInsertClick(Sender: TObject);
begin

  if lvIdents.SelCount <> 1 then
    Exit;

  if lvIdents.ItemIndex = -1 then
    Exit;

  if not InRange(lvIdents.ItemIndex, 0, High(FIdents)) then
    Exit;

  if AlgosimMainForm = nil then
    Exit;

  if AlgosimMainForm.teConsole = nil then
    Exit;

  if (AlgosimMainForm.teConsole.EditMode = emConsole) and not AlgosimMainForm.teConsole.TextFile.AtLastLine then
    AlgosimMainForm.teConsole.TextFile.GotoEOF;

  AlgosimMainForm.teConsole.SelText := FIdents[lvIdents.ItemIndex].Name;

end;

procedure TIdentFrm.mnuOpenClick(Sender: TObject);
begin
  OpenVar;
end;

procedure TIdentFrm.mnuRenameClick(Sender: TObject);
var
  Ident: TASKernel.TIdentInfo;
  S: string;
  Res: TAlgosimObject;
begin

  if lvIdents.SelCount <> 1 then
    Exit;

  if lvIdents.ItemIndex = -1 then
    Exit;

  if not InRange(lvIdents.ItemIndex, 0, High(FIdents)) then
    Exit;

  Ident := FIdents[lvIdents.ItemIndex];

  if not (Ident.IdentType in [itVariable, itFcnVariable]) then
    Exit;

  if iaProtected in Ident.Attributes then
  begin
    TD('The selected variable is protected and cannot be renamed.').Info.Execute;
    Exit;
  end;

  S := Ident.Name;

  if
    TMultiInputBox.TextInputBoxEx(
      GetParentForm(Self),
      'Algosim',
      'Please enter the name of the variable:',
      S,
      UITypes.TEditCharCase.ecNormal,
      FKernel.IsValidIdent
    )
    and
    (S <> Ident.Name)
  then
  begin

    if FKernel.VariableExists(S) then
    begin
      TD.TextFmt('There already exists a variable named "%s".', [S]).Info.Execute;
      Exit;
    end;

    Res := FKernel.Evaluate(
      (
        'if(succeeded(%NewName), error("There already exists a variable named ""%NewName"".")); ' +
        '%NewName ≔ %OldName; delete(%OldName)'
      )
      .Replace('%OldName', Ident.Name)
      .Replace('%NewName', S)
    );

    if IsFailure(Res) then
      raise Exception.Create(TAlgosimFailure(Res).FailureReason);

    UpdateIdents(FKernel);

  end;

end;

procedure TIdentFrm.mnuSaveAsClick(Sender: TObject);
var
  Ident: TASKernel.TIdentInfo;
  Obj: TAlgosimObject;
  LockInfo: TASKernel.TLockInfo;
begin

  if lvIdents.SelCount <> 1 then
    Exit;

  if lvIdents.ItemIndex = -1 then
    Exit;

  if not InRange(lvIdents.ItemIndex, 0, High(FIdents)) then
    Exit;

  Ident := FIdents[lvIdents.ItemIndex];

  if not (Ident.IdentType in [itVariable, itFcnVariable]) then
    Exit;

  if FKernel = nil then
    Exit;

  FKernel.LockObjStore(LockInfo);
  try

    Obj := FKernel.GetVariableRef(Ident.Name, I_Will_Not_Modify_The_Object);

    if Assigned(Obj) then
      Obj.SaveToFile(AlgosimMainForm, Ident.Name);

  finally
    FKernel.UnlockObjStore(LockInfo);
  end

end;

procedure TIdentFrm.mnuShowKernelFunctionsClick(Sender: TObject);
begin
  UpdateIdents(FKernel);
end;

procedure TIdentFrm.mnuShowOperatorsClick(Sender: TObject);
begin
  UpdateIdents(FKernel);
end;

procedure TIdentFrm.mnuShowVariablesClick(Sender: TObject);
begin
  UpdateIdents(FKernel);
end;

procedure TIdentFrm.CopyValueFmt(Sender: TObject);
begin
  if Sender is TMenuItem then
    CopyValueFmt(TMenuItem(Sender).Tag);
end;

procedure TIdentFrm.CopyValueFmt(AFormat: Integer);
var
  Ident: TASKernel.TIdentInfo;
  Obj: TAlgosimObject;
  LockInfo: TASKernel.TLockInfo;
begin

  if lvIdents.SelCount <> 1 then
    Exit;

  if lvIdents.ItemIndex = -1 then
    Exit;

  if not InRange(lvIdents.ItemIndex, 0, High(FIdents)) then
    Exit;

  Ident := FIdents[lvIdents.ItemIndex];

  if not (Ident.IdentType in [itVariable, itFcnVariable]) then
    Exit;

  if FKernel = nil then
    Exit;

  FKernel.LockObjStore(LockInfo);
  try

    Obj := FKernel.GetVariableRef(Ident.Name, I_Will_Not_Modify_The_Object);

    if Assigned(Obj) then
      case AFormat of
        0:
          Obj.CopyToClipboard;
        1:
          Clipboard.AsText := Obj.GetAsMultilineText(FKernel.FormatOptions);
        2:
          Clipboard.AsText := Obj.GetAsSingleLineText(FKernel.FormatOptions);
        3:
          Clipboard.AsText := Obj.ToPreviewString;
        4:
          Clipboard.AsText := Obj.ToInputString;
        5:
          Clipboard.AsText := Obj.ToString;
      end;

  finally
    FKernel.UnlockObjStore(LockInfo);
  end;

end;

procedure TIdentFrm.DeleteVars;
var
  Indices: TArray<Integer>;
  Ident: TASKernel.TIdentInfo;
  Names,
  Values,
  CMDs: TArray<string>;
  i, c: Integer;
  CMD: string;
  Res: TAlgosimObject;
  ProtectionCount: Integer;
begin

  if FKernel = nil then
    Exit;

  Indices := GetSelectedIndices;

  if Length(Indices) = 0 then
    Exit;

  SetLength(Names, Length(Indices));
  SetLength(Values, Length(Indices));
  c := 0;
  ProtectionCount := 0;
  for i := 0 to High(Indices) do
  begin
    if not InRange(Indices[i], 0, High(FIdents)) then
      Exit;
    Ident := FIdents[Indices[i]];
    if not (Ident.IdentType in [itVariable, itFcnVariable]) then
      Continue;
    if iaProtected in Ident.Attributes then
    begin
      Inc(ProtectionCount);
      Continue;
    end;
    Names[c] := Ident.Name;
    Values[c] := Ident.Preview;
    Inc(c);
  end;

  SetLength(Names, c);
  SetLength(Values, c);

  if c = 0 then
  begin
    if ProtectionCount > 0 then
      if Length(Indices) = 1 then
        TD('The selected variable is protected and cannot be deleted.').Info.Execute
      else
        TD('All of the selected variables are protected and cannot be deleted.').Info.Execute;
    Exit;
  end;

  if
    TTableDialog.ShowTable(
      AlgosimMainForm,
      'Algosim',
      'Do you want to delete these variables?',
      names,
      values,
      [mrYes, mrNo],
      ['&Yes', '&No'],
      mrYes,
      mrNo,
      mtConfirmation
    ) = mrYes
  then
  begin

    SetLength(CMDs, Length(Names));
    for i := 0 to High(Names) do
    begin
      if not IsValidIdent(Names[i]) then
        raise Exception.CreateFmt('"%s" is not a valid identifier.', [Names[i]]);
      CMDs[i] := Format('try(delete(%s))', [Names[i]]);
    end;

    CMD := string.Join('; ', CMDs);

    if CMD.IsEmpty then
      Exit;

    Res := FKernel.Evaluate(CMD);

    if IsFailure(Res) then
      raise Exception.Create(TAlgosimFailure(Res).FailureReason);

    UpdateIdents(FKernel);

  end;

end;

function TIdentFrm.GetSelectedIndices: TArray<Integer>;
var
  Idx, c: Integer;
begin
  SetLength(Result, lvIdents.SelCount);
  Idx := -1;
  c := 0;
  repeat
    Idx := ListView_GetNextItem(lvIdents.Handle, Idx, LVNI_SELECTED);
    if Idx <> -1 then
    begin
      Result[c] := Idx;
      Inc(c);
    end;
  until (Idx = -1) or (c = Length(Result));
end;

procedure TIdentFrm.lvIdentsData(Sender: TObject; Item: TListItem);

  function BriefTypeName(const S: string): string;
  const
    Prefix = 'structure of type "';
    Postfix = string('"');
  begin
    if S.StartsWith(Prefix) and S.EndsWith(Postfix) then
      Result := Copy(S, Succ(Prefix.Length), S.Length - Prefix.Length - Postfix.Length)
    else
      Result := S;
  end;

var
  Ident: TASKernel.TIdentInfo;
begin

  if Item = nil then
    Exit;

  if not InRange(Item.Index, 0, High(FIdents)) then
    Exit;

  Ident := FIdents[Item.Index];

  Item.Caption := Ident.Name;

  case Ident.IdentType of
    itFunction:
      begin
        Item.SubItems.Add(Ident.IdentType.ToString);
        Item.SubItems.Add('');
      end;
    itOperator:
      begin
        Item.SubItems.Add(Ident.&Operator.Kind.ToString);
        Item.SubItems.Add(Ident.&Operator.&Function.NodeName);
      end;
    itVariable,
    itFcnVariable:
      begin
        Item.SubItems.Add(BriefTypeName(Ident.TypeName));
        Item.SubItems.Add(Ident.Preview)
      end;
  end;

end;

procedure TIdentFrm.lvIdentsDblClick(Sender: TObject);
begin
  OpenVar;
end;

procedure TIdentFrm.lvIdentsKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_RETURN:
      OpenVar;
    VK_DELETE:
      DeleteVars;
    VK_F2:
      mnuRenameClick(Sender);
  end;
end;

procedure TIdentFrm.lvIdentsKeyPress(Sender: TObject; var Key: Char);
begin
  case Key of
    ^C:
      CopyValueFmt(0);
    ^S:
      mnuSaveAsClick(Sender);
  end;
end;

procedure TIdentFrm.OpenVar;
var
  Ident: TASKernel.TIdentInfo;
  Obj: TAlgosimObject;
  LockInfo: TASKernel.TLockInfo;
begin

  if lvIdents.SelCount <> 1 then
    Exit;

  if lvIdents.ItemIndex = -1 then
    Exit;

  if not InRange(lvIdents.ItemIndex, 0, High(FIdents)) then
    Exit;

  Ident := FIdents[lvIdents.ItemIndex];

  if not (Ident.IdentType in [itVariable, itFcnVariable]) then
    Exit;

  if FKernel = nil then
    Exit;

  FKernel.LockObjStore(LockInfo);
  try

    Obj := FKernel.GetVariableRef(Ident.Name, I_Will_Not_Modify_The_Object);

    if Assigned(Obj) then
      TGallery.CreateFrame(Obj, Ident.Name, True);

  finally
    FKernel.UnlockObjStore(LockInfo);
  end;

end;

procedure TIdentFrm.pmIdentsPopup(Sender: TObject);
var
  HasSel, SingleSel, IsVar: Boolean;
begin

  HasSel := lvIdents.SelCount > 0;
  SingleSel := (lvIdents.SelCount = 1) and (lvIdents.ItemIndex <> -1) and
    InRange(lvIdents.ItemIndex, 0, High(FIdents));
  IsVar := SingleSel and (FIdents[lvIdents.ItemIndex].IdentType in [itVariable, itFcnVariable]);

  mnuOpen.Enabled := IsVar;
  mnuInsert.Enabled := SingleSel;
  mnuCopyValueMultiline.Enabled := IsVar;
  mnuCopyValueSingleLine.Enabled := IsVar;
  mnuCopyValueTruncatedSingleLine.Enabled := IsVar;
  mnuCopyValueInputForm.Enabled := IsVar;
  mnuCopyValueDefault.Enabled := IsVar;
  mnuCopyValueUnformatted.Enabled := IsVar;
  mnuCopyName.Enabled := SingleSel;
  mnuDelete.Enabled := HasSel;
  mnuRename.Enabled := IsVar;
  mnuSaveAs.Enabled := IsVar;

end;

procedure TIdentFrm.UpdateIdents(AKernel: TASKernel);
var
  IdentTypes: TASKernel.TIdentTypes;
  i: Integer;
  Obj: TAlgosimObject;
  LIdents: TArray<TASKernel.TIdentInfo>;
  LockInfo: TASKernel.TLockInfo;
begin

  FKernel := AKernel;

  if AKernel = nil then
    Exit;

  IdentTypes := [];
  if mnuShowVariables.Checked then
  begin
    Include(IdentTypes, itVariable);
    Include(IdentTypes, itFcnVariable);
  end;
  if mnuShowKernelFunctions.Checked then
    Include(IdentTypes, itFunction);
  if mnuShowOperators.Checked then
    Include(IdentTypes, itOperator);

  try
    LIdents := AKernel.GetMatchingIdents(IdentTypes, '',
      mnuHideSystem.Checked);
  except
    on EObjStoreLocked do
      Exit;
  end;

  if Assigned(FKernel) and FKernel.TryLockObjStore(LockInfo) then
    try

      for i := 0 to High(LIdents) do
        if LIdents[i].IdentType = itVariable then
        begin
          try
            Obj := FKernel.GetVariableRef(LIdents[i].Name, I_Will_Not_Modify_The_Object);
            if Assigned(Obj) then
              LIdents[i].Preview := Obj.ToPreviewString;
          except
            on EUnknownIdentifier do                              // very unlikely
              LIdents[i].Preview := 'Variable no longer exists.';
          end;
        end;

    finally
      FKernel.UnlockObjStore(LockInfo);
    end
  else
    Exit;

  FIdents := LIdents; // strong guarantee

  lvIdents.Items.Count := Length(FIdents);
  lvIdents.Invalidate;
  lvIdents.AdjustColumns;

  StatusBar.SimplePanel := True;
  StatusBar.SimpleText := Length(FIdents).ToString + ' identifier(s)';

end;

end.
