unit VCSInfoMenuWzrd;

interface
uses
  System.Generics.Collections,
  ToolsAPI, Vcl.ComCtrls, Vcl.Controls;


type
  TRepoInfo = record
    Root: string;
    RepoType: string;
    Branch: string;
................................................................................
      function GetProjectRepo(const AForceUpdate: Boolean; out AFileName: string): TRepoInfo; overload;
      function GetProjectRepo(const AForceUpdate: Boolean = False): TRepoInfo; overload; inline;
      function GetActiveFileRepo(const AForceUpdate: Boolean; out AFileName: string): TRepoInfo; overload;
      function GetActiveFileRepo(const AForceUpdate: Boolean = False): TRepoInfo; overload; inline;

      procedure LogMessage(const Text: string); overload;
      procedure LogMessage(const Text: string; const Args: array of const); overload;



    public
      constructor Create;
      destructor Destroy; override;

      { IOTAWizard }
      function GetIDString: string;
      function GetName: string;
................................................................................
procedure Register;

implementation
uses
  System.SysUtils, System.UITypes, System.Classes, System.StrUtils,
  Vcl.Forms, Vcl.Dialogs,
  Winapi.Windows,
  u_FinalPathName, Vcl.ActnList, Vcl.Graphics, Vcl.Menus;

const
  scMenuIDString = 'net.2of4.VCSInfoWizard';

{ ------------------------------------------------------------------------------------------------ }
procedure Register;
begin
................................................................................
{ ------------------------------------------------------------------------------------------------ }
destructor TVCSInfoWizard.Destroy;
var
  Services: INTAServices;
  Button: TToolButton;
  i: Integer;
begin

  Supports(ToolsAPI.BorlandIDEServices, INTAServices, {out}Services);
  for i := FToolbar.ButtonCount - 1 downto 0 do begin
    Button := FToolbar.Buttons[i];
    FToolbar.Perform(CM_CONTROLCHANGE, WPARAM(Button), 0);
    Button.Free;
  end;
  Services.WriteToolbar(FToolbar);
  FToolbar.Free;
  FRepos.Free;

  inherited;
end;


procedure TVCSInfoWizard.actBranchUpdate(Sender: TObject);
var
  actBranch: TAction;
  Repo: TRepoInfo;
  NewImageIndex: Integer;
  NewCaption, NewHint: string;
  NewEnabled: boolean;
begin

  actBranch := TAction(Sender);

  Repo := GetActiveFileRepo;
  NewEnabled := Repo.IsRepo;
  if Repo.IsRepo then begin
    NewCaption := Repo.Branch;
    case Repo.Pending of
      -1: begin
        NewImageIndex := FImgUnknown;
        NewHint := 'Unable to determine status';
      end;
       0: begin
        NewImageIndex := FImgClean;
        NewHint := 'Working directory is clean';
       end
      else begin
        NewImageIndex := FImgPending;
        NewHint := Format('%d file(s) pending', [Repo.Pending]);
      end;
    end;
  end else begin
    NewImageIndex := -1; // FImgNeutral;
    if Repo.Root = '' then begin
      NewCaption := '(no active project)';
    end else begin
      NewCaption := '(no repository)';
    end;
    NewHint := 'No repository';
  end;

  if (actBranch.ImageIndex <> NewImageIndex)
      or (actBranch.Caption <> NewCaption)
      or (actBranch.Hint <> NewHint)
      or (actBranch.Enabled <> NewEnabled) then begin
    actBranch.Enabled := NewEnabled;
    actBranch.ImageIndex := NewImageIndex;
    actBranch.Caption := NewCaption;
    actBranch.Hint := NewHint;

    FToolbar.Invalidate;
    LogMessage('actBranchUpdate: IsRepo=%d, In=%d, Out=%d; Img=%d, Caption="%s", Hint="%s"',
                [Ord(Repo.IsRepo), Repo.Incoming, Repo.Outgoing, NewImageIndex, NewCaption, NewHint]);





  end;
end;

procedure TVCSInfoWizard.actBranchExecute(Sender: TObject);
var
  Repo: TRepoInfo;
begin
................................................................................
        RaiseLastOSError;
    end;
  end;
end;

procedure TVCSInfoWizard.actBranchMenuClick(Sender: TObject);
var
  Item: TMenuItem;
  Repo: TRepoInfo;
  Modules: IOTAModuleServices;
  i: Integer;
  Output: string;
  iRes: Cardinal;
  MsgType: TMsgDlgType;
begin
  Item := Sender as TMenuItem;
  Repo := GetActiveFileRepo;
  if Repo.IsRepo then begin
    Supports(ToolsAPI.BorlandIDEServices, IOTAModuleServices, {out}Modules);
    if not Modules.SaveAll then
      Exit;
    {$MESSAGE HINT 'TODO: perhaps close the project?'}
    case IndexStr(Repo.RepoType, ['hg', 'fossil']) of
      0: begin // hg
        if not CreateProcess('thg update --rev "' + Item.Caption + '"', Repo.Root) then
          RaiseLastOSError;
      end;
      1: begin // fossil
        iRes := ExecuteCmd('fossil checkout "' + Item.Caption + '"', Output, False, nil, Repo.Root);
        if iRes <> 0 then begin
          if TaskMessageDlg(Repo.Root, Output, mtWarning, [mbRetry, mbCancel], 0) = mrCancel then
            Exit;
          iRes := ExecuteCmd('fossil update "' + Item.Caption + '"', Output, False, nil, Repo.Root);
        end;
        if iRes = 0 then
          MsgType := mtInformation
        else
          MsgType := mtError;
        TaskMessageDlg(Repo.Root, Output, MsgType, [mbOK], 0);
      end;
    end;
    {$MESSAGE WARN 'TODO: Wait for the process to terminate, and only THEN refresh all files — MCO 19-11-2015'}
    {$MESSAGE HINT 'TODO: reopen the project if we closed it'}
    for i := Modules.ModuleCount - 1 downto 0 do begin
      Modules.Modules[i].Refresh(False);
    end;
  end;
end;



procedure TVCSInfoWizard.actBranchMenuPopup(Sender: TObject);
var
  Menu: TPopupMenu;
  Repo: TRepoInfo;
  Branches: TStringList;
  Branch: string;
................................................................................
    end;
  end;
end;

procedure TVCSInfoWizard.actSyncUpdate(Sender: TObject);
var
  actSync: TAction;
  Repo: TRepoInfo;












  NewImageIndex: Integer;


  NewCaption: string;
  NewEnabled: boolean;
begin
  actSync := Sender as TAction;
  Repo := GetActiveFileRepo;
  NewEnabled := Repo.IsRepo;
  if Repo.IsRepo then begin







    if (Repo.Incoming < 0) and (Repo.Outgoing < 0) then begin
      NewImageIndex := FImgUnknown;
      NewCaption := 'Error while checking remote repository';


    end else if Repo.Incoming > 0 then begin


      if Repo.Outgoing > 0 then begin
        NewImageIndex := FImgSyncBoth;
        NewCaption := Format('%d pull(s), %d push(es)', [Repo.Incoming, Repo.Outgoing]);




      end else begin




        NewImageIndex := FImgSyncPull;


        NewCaption := Format('%d pull(s)', [Repo.Incoming]);
      end;
    end else if Repo.Outgoing > 0 then begin
      NewImageIndex := FImgSyncPush;
      NewCaption := Format('%d push(es)', [Repo.Outgoing]);



    end else begin
      NewImageIndex := FImgSyncNone;
      NewCaption := 'nothing to sync';


    end;
  end else begin
    NewImageIndex := FImgUnknown;
    NewCaption := '(no repository)';
  end;

  if (NewImageIndex <> actSync.ImageIndex) or (NewCaption <> actSync.Caption) or (NewEnabled <> actSync.Enabled) then begin
................................................................................
    actSync.Hint := actSync.Caption;
    actSync.Enabled := NewEnabled;

    FToolbar.Invalidate;
    LogMessage('actSyncUpdate: IsRepo=%d, In=%d, Out=%d; Caption="%s", Img=%d',
                [Ord(Repo.IsRepo), Repo.Incoming, Repo.Outgoing, NewCaption, NewImageIndex]);
  end;

















































end {TVCSInfoWizard.actSyncUpdate};

{ ------------------------------------------------------------------------------------------------ }
function TVCSInfoWizard.GetMenuText: string;
var
  Project: IOTAProject;
  Repo: TRepoInfo;
begin
................................................................................
const
  RFC3339: TFormatSettings = (DateSeparator: '-'; TimeSeparator: ':';
                              ShortDateFormat: 'yyyy-MM-dd'; LongDateFormat: 'yyyy-MM-dd';
                              ShortTimeFormat: 'hh:nn:ss'; LongTimeFormat: 'hh:nn:ss.zzz');
var
  Messages: IOTAMessageServices;
  Group: IOTAMessageGroup;

begin
  if not Supports(ToolsAPI.BorlandIDEServices, IOTAMessageServices, {out}Messages) then
    Exit;
  Group := Messages.GetGroup(Self.ClassName);
  if Group = nil then begin
    Group := Messages.AddMessageGroup(Self.ClassName);
    Group.CanClose := True;
    Group.AutoScroll := True;
  end;
  Messages.AddTitleMessage(DateTimeToStr(Now, RFC3339) + ' ' + Text, Group);





end {TVCSInfoWizard.LogMessage};

{ ------------------------------------------------------------------------------------------------ }
procedure TVCSInfoWizard.Execute;
var
  Project: IOTAProject;
  CodeFile: string;
................................................................................
            iRes := ExecuteCmd('fossil changes', Lines.Append, False, nil, FilePath);
            if iRes = 0 then begin
              Result.Pending := Lines.Count;
            end else begin
              Result.Pending := -1;
            end;

            Result.Incoming := -1;
            Lines.Clear;
            iRes := ExecuteCmd('fossil settings autosync', Lines.Append, False, nil, FilePath);


            if (iRes = 0) and (Lines.Count > 0) and TryStrToInt(Lines[0].Substring(28).Trim, Integer(iRes)) then begin
              if (iRes > 0) then begin
                // autosync is enabled; check for a remote-url
                Line := '';
                iRes := ExecuteCmd('fossil remote-url', Line, False, nil, FilePath);
                if (iRes = 0) and (Line <> 'off') then begin
                  Result.Incoming := 0;
                end;
              end;
            end;
            Result.Outgoing := Result.Incoming;

            Result.LastUpdated := Now;
          end;
        end;
      finally
        Lines.Free;
      end;

unit VCSInfoMenuWzrd;

interface
uses
  System.Generics.Collections,
  ToolsAPI, Vcl.ComCtrls, Vcl.Controls, Vcl.ActnList;


type
  TRepoInfo = record
    Root: string;
    RepoType: string;
    Branch: string;
................................................................................
      function GetProjectRepo(const AForceUpdate: Boolean; out AFileName: string): TRepoInfo; overload;
      function GetProjectRepo(const AForceUpdate: Boolean = False): TRepoInfo; overload; inline;
      function GetActiveFileRepo(const AForceUpdate: Boolean; out AFileName: string): TRepoInfo; overload;
      function GetActiveFileRepo(const AForceUpdate: Boolean = False): TRepoInfo; overload; inline;

      procedure LogMessage(const Text: string); overload;
      procedure LogMessage(const Text: string; const Args: array of const); overload;

      procedure RefreshSyncStatus(const actSync: TAction);
      procedure SwitchToRevision(const Revision: string);
    public
      constructor Create;
      destructor Destroy; override;

      { IOTAWizard }
      function GetIDString: string;
      function GetName: string;
................................................................................
procedure Register;

implementation
uses
  System.SysUtils, System.UITypes, System.Classes, System.StrUtils,
  Vcl.Forms, Vcl.Dialogs,
  Winapi.Windows,
  u_FinalPathName, Vcl.Graphics, Vcl.Menus;

const
  scMenuIDString = 'net.2of4.VCSInfoWizard';

{ ------------------------------------------------------------------------------------------------ }
procedure Register;
begin
................................................................................
{ ------------------------------------------------------------------------------------------------ }
destructor TVCSInfoWizard.Destroy;
var
  Services: INTAServices;
  Button: TToolButton;
  i: Integer;
begin
  try
    Supports(ToolsAPI.BorlandIDEServices, INTAServices, {out}Services);
    for i := FToolbar.ButtonCount - 1 downto 0 do begin
      Button := FToolbar.Buttons[i];
      FToolbar.Perform(CM_CONTROLCHANGE, WPARAM(Button), 0);
      Button.Free;
    end;
    Services.WriteToolbar(FToolbar);
    FToolbar.Free;
    FRepos.Free;
  finally
    inherited;
  end;
end {TVCSInfoWizard.Destroy};

procedure TVCSInfoWizard.actBranchUpdate(Sender: TObject);
var
  actBranch: TAction;
  Repo: TRepoInfo;
  NewImageIndex: Integer;
  NewCaption, NewHint: string;
  NewEnabled: boolean;
begin
  try
    actBranch := Sender as TAction;

    Repo := GetActiveFileRepo;
    NewEnabled := Repo.IsRepo;
    if Repo.IsRepo then begin
      NewCaption := Repo.Branch;
      case Repo.Pending of
        -1: begin
          NewImageIndex := FImgUnknown;
          NewHint := 'Unable to determine status';
        end;
         0: begin
          NewImageIndex := FImgClean;
          NewHint := 'Working directory is clean';
         end
        else begin
          NewImageIndex := FImgPending;
          NewHint := Format('%d file(s) pending', [Repo.Pending]);
        end;
      end;
    end else begin
      NewImageIndex := -1; // FImgNeutral;
      if Repo.Root = '' then begin
        NewCaption := '(no active project)';
      end else begin
        NewCaption := '(no repository)';
      end;
      NewHint := 'No repository';
    end;

    if (actBranch.ImageIndex <> NewImageIndex)
        or (actBranch.Caption <> NewCaption)
        or (actBranch.Hint <> NewHint)
        or (actBranch.Enabled <> NewEnabled) then begin
      actBranch.Enabled := NewEnabled;
      actBranch.ImageIndex := NewImageIndex;
      actBranch.Caption := NewCaption;
      actBranch.Hint := NewHint;

      FToolbar.Invalidate;
      LogMessage('actBranchUpdate: IsRepo=%d, In=%d, Out=%d; Img=%d, Caption="%s", Hint="%s"',
                  [Ord(Repo.IsRepo), Repo.Incoming, Repo.Outgoing, NewImageIndex, NewCaption, NewHint]);
    end;
  except
    on E: Exception do begin
      LogMessage('actBranchUpdate raised ' + E.ClassName + sLineBreak + E.ToString);
    end;
  end;
end;

procedure TVCSInfoWizard.actBranchExecute(Sender: TObject);
var
  Repo: TRepoInfo;
begin
................................................................................
        RaiseLastOSError;
    end;
  end;
end;

procedure TVCSInfoWizard.actBranchMenuClick(Sender: TObject);
var




  BranchName: string;


begin
  BranchName := (Sender as TMenuItem).Caption;
































  SwitchToRevision(BranchName);
end {TVCSInfoWizard.actBranchMenuClick};

procedure TVCSInfoWizard.actBranchMenuPopup(Sender: TObject);
var
  Menu: TPopupMenu;
  Repo: TRepoInfo;
  Branches: TStringList;
  Branch: string;
................................................................................
    end;
  end;
end;

procedure TVCSInfoWizard.actSyncUpdate(Sender: TObject);
var
  actSync: TAction;
begin
  try
    actSync := Sender as TAction;
    RefreshSyncStatus(actSync);
  except
    on E: Exception do begin
      LogMessage('actSyncUpdate raised ' + E.ClassName + sLineBreak + E.ToString);
    end;
  end;
end {TVCSInfoWizard.actSyncUpdate};

procedure TVCSInfoWizard.RefreshSyncStatus(const actSync: TAction);
var
  NewImageIndex: Integer;
  Repo: TRepoInfo;
  NewEnabled: Boolean;
  NewCaption: string;

begin

  Repo := GetActiveFileRepo;
  NewEnabled := Repo.IsRepo;
  if Repo.IsRepo then begin
    if Repo.Incoming = 0 then begin
      NewImageIndex := FImgSyncNone;
      if Repo.Outgoing = 0 then begin
        NewCaption := 'nothing to sync';
      end else if Repo.Outgoing > 0 then begin
        NewImageIndex := FImgSyncPush;
        NewCaption := Format('%d push(es)', [Repo.Outgoing]);
      end else begin // Repo.Outgoing < 0
        NewImageIndex := FImgUnknown;

        NewCaption := 'no pulls, pushes unknown';
      end;
    end else if Repo.Incoming > 0 then begin
      NewImageIndex := FImgSyncPull;
      NewCaption := Format('%d pull(s)', [Repo.Incoming]);
      if Repo.Outgoing > 0 then begin
        NewImageIndex := FImgSyncBoth;

        NewCaption := Format('%s, %d push(es)', [NewCaption, Repo.Outgoing]);
      end else if Repo.Outgoing < 0 then begin
        NewCaption := Format('%s, pushes unknown', [NewCaption]);
      end;
    end else begin // Repo.Incoming < 0
      NewImageIndex := FImgUnknown;
      NewCaption := 'pulls unknown';
      if Repo.Outgoing = 0 then begin
        if Repo.RepoType = 'fossil' then begin
          NewImageIndex := FImgSyncNone;
          NewCaption := 'autosync is on';
        end else begin
          NewCaption := Format('%s, no pushes', [NewCaption]);
        end;
      end else if Repo.Outgoing > 0 then begin
        NewImageIndex := FImgSyncPush;
        NewCaption := Format('%1:d push(es), %0:s', [NewCaption, Repo.Outgoing]);
      end else begin // Repo.Outgoing < 0
        if Repo.RepoType = 'fossil' then begin
          NewCaption := 'autosync is off, or no remote-url';
        end else begin

          NewCaption := 'unable to check remote repository';
        end;
      end;
    end;
  end else begin
    NewImageIndex := FImgUnknown;
    NewCaption := '(no repository)';
  end;

  if (NewImageIndex <> actSync.ImageIndex) or (NewCaption <> actSync.Caption) or (NewEnabled <> actSync.Enabled) then begin
................................................................................
    actSync.Hint := actSync.Caption;
    actSync.Enabled := NewEnabled;

    FToolbar.Invalidate;
    LogMessage('actSyncUpdate: IsRepo=%d, In=%d, Out=%d; Caption="%s", Img=%d',
                [Ord(Repo.IsRepo), Repo.Incoming, Repo.Outgoing, NewCaption, NewImageIndex]);
  end;
end;

procedure TVCSInfoWizard.SwitchToRevision(const Revision: string);
var
  i: Integer;
  iRes: Cardinal;
  Repo: TRepoInfo;
  Output: string;
  MsgType: TMsgDlgType;
  Modules: IOTAModuleServices;
begin
  Repo := GetActiveFileRepo;
  if Repo.IsRepo then begin
    Supports(ToolsAPI.BorlandIDEServices, IOTAModuleServices, {out}Modules);

    // Always save all files before switching to a different branch
    if not Modules.SaveAll then
      Exit;

    // TODO: perhaps close the project, to prevent instability in the IDE?

    case IndexStr(Repo.RepoType, ['hg', 'fossil']) of
      0: begin // hg
        if not CreateProcess(Format('thg update --rev "%s"', [Revision]), Repo.Root) then
          RaiseLastOSError;
        // TODO: Wait for the process to terminate, and only THEN refresh all files
      end;
      1: begin // fossil
        iRes := ExecuteCmd(Format('fossil checkout "%s"', [Revision]), Output, False, nil, Repo.Root);
        if iRes <> 0 then begin
          if TaskMessageDlg(Repo.Root, Output, mtWarning, [mbRetry, mbCancel], 0) = mrCancel then
            Exit;
          iRes := ExecuteCmd(Format('fossil update "%s"', [Revision]), Output, False, nil, Repo.Root);
        end;
        if iRes = 0 then
          MsgType := mtInformation
        else
          MsgType := mtError;
        TaskMessageDlg(Repo.Root, Output, MsgType, [mbOK], 0);

        for i := Modules.ModuleCount - 1 downto 0 do begin
          Modules.Modules[i].Refresh(False);
        end;
      end;
    end;

    // TODO: if we closed the project, reopen it

  end;
end {TVCSInfoWizard.SwitchToBranch};

{ ------------------------------------------------------------------------------------------------ }
function TVCSInfoWizard.GetMenuText: string;
var
  Project: IOTAProject;
  Repo: TRepoInfo;
begin
................................................................................
const
  RFC3339: TFormatSettings = (DateSeparator: '-'; TimeSeparator: ':';
                              ShortDateFormat: 'yyyy-MM-dd'; LongDateFormat: 'yyyy-MM-dd';
                              ShortTimeFormat: 'hh:nn:ss'; LongTimeFormat: 'hh:nn:ss.zzz');
var
  Messages: IOTAMessageServices;
  Group: IOTAMessageGroup;
  TimeStamp, Line: string;
begin
  if not Supports(ToolsAPI.BorlandIDEServices, IOTAMessageServices, {out}Messages) then
    Exit;
  Group := Messages.GetGroup(Self.ClassName);
  if Group = nil then begin
    Group := Messages.AddMessageGroup(Self.ClassName);
    Group.CanClose := True;
    Group.AutoScroll := True;
  end;
  TimeStamp := DateTimeToStr(Now, RFC3339);
  for Line in Text.Replace(#13#10, #10).Split([#10, #13]) do begin
    Messages.AddTitleMessage(TimeStamp + #9 + Line, Group);
    if TimeStamp[1] <> #9 then
      TimeStamp := StringOfChar(#9, 2);
  end;
end {TVCSInfoWizard.LogMessage};

{ ------------------------------------------------------------------------------------------------ }
procedure TVCSInfoWizard.Execute;
var
  Project: IOTAProject;
  CodeFile: string;
................................................................................
            iRes := ExecuteCmd('fossil changes', Lines.Append, False, nil, FilePath);
            if iRes = 0 then begin
              Result.Pending := Lines.Count;
            end else begin
              Result.Pending := -1;
            end;


            Lines.Clear;
            iRes := ExecuteCmd('fossil settings autosync', Lines.Append, False, nil, FilePath);
            Result.Incoming := -1;
            Result.Outgoing := -1;
            if (iRes = 0) and (Lines.Count > 0) and TryStrToInt(Lines[0].Substring(28).Trim, Integer(iRes)) then begin
              if (iRes > 0) then begin
                // autosync is enabled; check for a remote-url
                Line := '';
                iRes := ExecuteCmd('fossil remote-url', Line, False, nil, FilePath);
                if (iRes = 0) and (Line <> 'off') then begin
                  Result.Outgoing := 0;
                end;
              end;
            end;


            Result.LastUpdated := Now;
          end;
        end;
      finally
        Lines.Free;
      end;