RAD Studio VCS Info
Check-in [18217c831e]
Login
HomeTimelineBranchesTagsTicketsWiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added toolbar, action and button (with generated image). Does nothing useful for the moment, but it's a first step.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:18217c831e5bf61299dbd36725fb9122c217c7f0
User & Date: tinus 2015-11-18 20:16:29
Context
2015-11-18
21:46
Populate a list of active branches, and allows updating to them. check-in: 0fbed40d59 user: tinus tags: trunk
20:16
Added toolbar, action and button (with generated image). Does nothing useful for the moment, but it's a first step. check-in: 18217c831e user: tinus tags: trunk
14:23
Indicate unsynced changes in the dialog's icon. check-in: a9f8ccfbac user: tinus tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/Delphi10/VCSInfo.dproj. 

196
197
198
199
200
201
202
203









204
205
206
207
208
209
210
...
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533

                </DeployFile>
                <DeployFile LocalName="C:\Users\Public\Documents\Embarcadero\Studio\15.0\Bpl\VCSInfo.bpl" Configuration="Debug" Class="ProjectOutput">
                    <Platform Name="Win32">
                        <RemoteName>VCSInfo.bpl</RemoteName>
                        <Overwrite>true</Overwrite>
                    </Platform>
                </DeployFile>
                <DeployClass Name="ProjectiOSDeviceResourceRules"/>









                <DeployClass Name="ProjectOSXResource">
                    <Platform Name="OSX32">
                        <RemoteDir>Contents\Resources</RemoteDir>
                        <Operation>1</Operation>
                    </Platform>
                </DeployClass>
                <DeployClass Name="AndroidClassesDexFile">
................................................................................
                </DeployClass>
                <DeployClass Name="Android_LauncherIcon36">
                    <Platform Name="Android">
                        <RemoteDir>res\drawable-ldpi</RemoteDir>
                        <Operation>1</Operation>
                    </Platform>
                </DeployClass>
                <DeployClass Name="DependencyModule">
                    <Platform Name="Win32">
                        <Operation>0</Operation>
                        <Extensions>.dll;.bpl</Extensions>
                    </Platform>
                    <Platform Name="OSX32">
                        <Operation>1</Operation>
                        <Extensions>.dylib</Extensions>
                    </Platform>
                </DeployClass>
                <ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
                <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
                <ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>








|
>
>
>
>
>
>
>
>
>







 







|
<
<
<
<
<
<
<
<
<








196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
...
519
520
521
522
523
524
525
526









527
528
529
530
531
532
533

                </DeployFile>
                <DeployFile LocalName="C:\Users\Public\Documents\Embarcadero\Studio\15.0\Bpl\VCSInfo.bpl" Configuration="Debug" Class="ProjectOutput">
                    <Platform Name="Win32">
                        <RemoteName>VCSInfo.bpl</RemoteName>
                        <Overwrite>true</Overwrite>
                    </Platform>
                </DeployFile>
                <DeployClass Name="DependencyModule">
                    <Platform Name="Win32">
                        <Operation>0</Operation>
                        <Extensions>.dll;.bpl</Extensions>
                    </Platform>
                    <Platform Name="OSX32">
                        <Operation>1</Operation>
                        <Extensions>.dylib</Extensions>
                    </Platform>
                </DeployClass>
                <DeployClass Name="ProjectOSXResource">
                    <Platform Name="OSX32">
                        <RemoteDir>Contents\Resources</RemoteDir>
                        <Operation>1</Operation>
                    </Platform>
                </DeployClass>
                <DeployClass Name="AndroidClassesDexFile">
................................................................................
                </DeployClass>
                <DeployClass Name="Android_LauncherIcon36">
                    <Platform Name="Android">
                        <RemoteDir>res\drawable-ldpi</RemoteDir>
                        <Operation>1</Operation>
                    </Platform>
                </DeployClass>
                <DeployClass Name="ProjectiOSDeviceResourceRules"/>









                <ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
                <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
                <ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>

Changes to src/VCSInfoMenuWzrd.pas. 

1
2
3
4
5
6
7
8
9
10
11
12
13
..
15
16
17
18
19
20
21


22
23
24

25
26
27
28
29
30
31
32
33
34


35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
...
326
327
328
329
330
331
332
333

































334


335





336
337
338






339
340
341
342
343
344
345
...
409
410
411
412
413
414
415


416


417
418
419
420
421
422
423

unit VCSInfoMenuWzrd;

interface
uses
  System.Generics.Collections,
  ToolsAPI;


type
  TRepoInfo = record
    Root: string;
    IsRepo: Boolean;
    Incoming: Cardinal;
................................................................................
    LastUpdated: TDateTime;
  end;

  // TODO: implement IOTAEditorNotifier and/or IOTAIDENotifier so we know which file is active
  TVCSInfoWizard = class(TNotifierObject, IOTAWizard, IOTAMenuWizard)
    private
      FRepos: TDictionary<string,TRepoInfo>;



      function GetRepoInfo(const AFileName: string; const AForceUpdate: Boolean = False): TRepoInfo;
    public

      destructor Destroy; override;

      { IOTAWizard }
      function GetIDString: string;
      function GetName: string;
      function GetState: TWizardState;
      procedure Execute;

      { IOTAMenuWizard }
      function GetMenuText: string;


  end;

procedure Register;

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

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

{ ------------------------------------------------------------------------------------------------ }
procedure Register;
begin
................................................................................
    Result := False;
  end;
end {CreateProcess};

{ ================================================================================================ }
{ TVCSInfoWizard }

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

































destructor TVCSInfoWizard.Destroy;


begin





  FRepos.Free;
  inherited;
end;







{ ------------------------------------------------------------------------------------------------ }
function TVCSInfoWizard.GetMenuText: string;
var
  Project: IOTAProject;
  Info: TRepoInfo;
begin
................................................................................
      ExecuteCmd('hg -y summary --remote', Msg, False, nil, ExtractFileDir(CodeFile));
      case TaskMessageDlg('Launch TortoiseHg?',
                          Info.Root + #13#10#13#10 +
                          Msg,
                          MsgType, [mbYes, mbNo], 0, mbYes) of
        mrYes: CreateProcess('thg log', ExtractFileDir(CodeFile));
      end;


    end;


  end;
end {TVCSInfoWizard.Execute};

{ ------------------------------------------------------------------------------------------------ }
function TVCSInfoWizard.GetIDString: string;
begin
  Result := scMenuIDString;






|







 







>
>



>










>
>









|







 








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>

>
>
>
>
>



>
>
>
>
>
>







 







>
>

>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
..
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
...
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
...
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478

unit VCSInfoMenuWzrd;

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


type
  TRepoInfo = record
    Root: string;
    IsRepo: Boolean;
    Incoming: Cardinal;
................................................................................
    LastUpdated: TDateTime;
  end;

  // TODO: implement IOTAEditorNotifier and/or IOTAIDENotifier so we know which file is active
  TVCSInfoWizard = class(TNotifierObject, IOTAWizard, IOTAMenuWizard)
    private
      FRepos: TDictionary<string,TRepoInfo>;
      FToolbar: TToolBar;
      FButtonIn: TControl;

      function GetRepoInfo(const AFileName: string; const AForceUpdate: Boolean = False): TRepoInfo;
    public
      constructor Create;
      destructor Destroy; override;

      { IOTAWizard }
      function GetIDString: string;
      function GetName: string;
      function GetState: TWizardState;
      procedure Execute;

      { IOTAMenuWizard }
      function GetMenuText: string;

      procedure actIncomingExecute(Sender: TObject);
  end;

procedure Register;

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

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

{ ------------------------------------------------------------------------------------------------ }
procedure Register;
begin
................................................................................
    Result := False;
  end;
end {CreateProcess};

{ ================================================================================================ }
{ TVCSInfoWizard }

{ ------------------------------------------------------------------------------------------------ }
constructor TVCSInfoWizard.Create;
var
  Services: INTAServices;
  actIncoming: TAction;
  bmpCount: TBitmap;
begin
  Supports(BorlandIDEServices, INTAServices, Services);
  FToolbar := Services.NewToolbar('tlbVCSInfo', 'VCS Info');

  bmpCount := TBitmap.Create;
  bmpCount.SetSize(16, 16);
  bmpCount.Canvas.Brush.Color := clLime; // clBtnFace;
  bmpCount.Canvas.Brush.Style := bsSolid;
  bmpCount.Canvas.FillRect(Rect(0, 0, 16, 16));
  bmpCount.TransparentColor := clFuchsia;

  actIncoming := TAction.Create(FToolbar);
  actIncoming.Caption := '(0)';
  actIncoming.Enabled := True;
  actIncoming.ImageIndex := Services.AddMasked(bmpCount, bmpCount.TransparentColor, 'net.2of4.actIncoming');
  actIncoming.OnExecute := actIncomingExecute;

  FButtonIn := Services.AddToolButton(FToolbar.Name, 'btnIncoming', actIncoming);
  if FButtonIn is TToolButton then begin
    with TToolButton(FButtonIn) do begin
      Style := tbsTextButton;
    end;
  end;

  FToolbar.Visible := True;
  FToolbar.Invalidate;
end;
{ ------------------------------------------------------------------------------------------------ }
destructor TVCSInfoWizard.Destroy;
var
  Button: TToolButton;
begin
  FButtonIn.Action.Free;
  for Button in FToolbar do begin
    FToolbar.Perform(CM_CONTROLCHANGE, WPARAM(Button), 0);
  end;
  FToolbar.Free;
  FRepos.Free;
  inherited;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TVCSInfoWizard.actIncomingExecute(Sender: TObject);
begin
  Self.Execute;
end;

{ ------------------------------------------------------------------------------------------------ }
function TVCSInfoWizard.GetMenuText: string;
var
  Project: IOTAProject;
  Info: TRepoInfo;
begin
................................................................................
      ExecuteCmd('hg -y summary --remote', Msg, False, nil, ExtractFileDir(CodeFile));
      case TaskMessageDlg('Launch TortoiseHg?',
                          Info.Root + #13#10#13#10 +
                          Msg,
                          MsgType, [mbYes, mbNo], 0, mbYes) of
        mrYes: CreateProcess('thg log', ExtractFileDir(CodeFile));
      end;
    end else begin
      TaskMessageDlg('No repository', ExtractFileName(Project.FileName) + ' is not in a Mercurial repository.', mtError, [mbOK], 0);
    end;
  end else begin
    TaskMessageDlg('No project loaded', '', mtError, [mbOK], 0);
  end;
end {TVCSInfoWizard.Execute};

{ ------------------------------------------------------------------------------------------------ }
function TVCSInfoWizard.GetIDString: string;
begin
  Result := scMenuIDString;

Powered by Fossil · RSS · Site map