RAD Studio VCS Info
Check-in [c92164b9f9]
Login
HomeTimelineBranchesTagsTicketsWiki

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

Overview
Comment:Run commands in the repo root by default. Implemented Fossil.GetBranches.
Timelines: family | ancestors | descendants | both | feature/rewrite-multi-async
Files: files | file ages | folders
SHA1: c92164b9f906b694f1e4432fde1c45024af6e729
User & Date: tinus 2016-02-22 18:50:48.397
Context
2016-02-22
18:52
Encode all source files in UTF-8. check-in: 5ca0dccf2c user: tinus tags: feature/rewrite-multi-async
18:50
Run commands in the repo root by default. Implemented Fossil.GetBranches. check-in: c92164b9f9 user: tinus tags: feature/rewrite-multi-async
18:34
Added console running code to TVCSClient. check-in: 20d7dd8edd user: tinus tags: feature/rewrite-multi-async
Changes
Unified Diff Ignore Whitespace Patch
Changes to src/vcsinfo.Fossil.pas. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

unit vcsinfo.Fossil;

interface
uses
  vcsinfo.VCSClient;

type
  TVCSFossil = class(TVCSClient)
  strict protected
    class function IsRepo(const APath: string; out ARootPath: string): boolean; override;
  strict protected
    function  GetExecutable: string; override;
    function  GetUIExecutable: string; override;
    function  GetTitle: string; override;
  public
    constructor Create(const APath: string);









|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

unit vcsinfo.Fossil;

interface
uses
  vcsinfo.VCSClient;

type
  TVCSFossil = class(TVCSClient)
  public
    class function IsRepo(const APath: string; out ARootPath: string): boolean; override;
  strict protected
    function  GetExecutable: string; override;
    function  GetUIExecutable: string; override;
    function  GetTitle: string; override;
  public
    constructor Create(const APath: string);
︙︙
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
57
58
59
60
61

    procedure ShowStatusUI; override;
    function  SwitchToBranchUI(const BranchName: string): boolean; override;

    procedure ProcessRename(const OldName, NewName: string); override;
  end;

implementation



{ TVCSFossil }

constructor TVCSFossil.Create(const APath: string);
begin
  inherited;

end;

destructor TVCSFossil.Destroy;
begin

  inherited;
end;

function TVCSFossil.GetBranches: TArray<string>;




begin






  {$MESSAGE WARN 'TODO: fossil branch list; put the current one first'}














end;

function TVCSFossil.GetExecutable: string;
begin
  Result := 'fossil.exe';
end;









>
>
















>
>
>
>

>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>








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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87

    procedure ShowStatusUI; override;
    function  SwitchToBranchUI(const BranchName: string): boolean; override;

    procedure ProcessRename(const OldName, NewName: string); override;
  end;

implementation
uses
  System.Classes, System.SysUtils;

{ TVCSFossil }

constructor TVCSFossil.Create(const APath: string);
begin
  inherited;

end;

destructor TVCSFossil.Destroy;
begin

  inherited;
end;

function TVCSFossil.GetBranches: TArray<string>;
var
  Lines: TStringList;
  RetVal: Cardinal;
  i: Integer;
begin
  Lines := TStringList.Create;
  try
    RetVal := ExecuteCmd('fossil branch list', Lines.Append);
    if RetVal <> 0 then
      raise EVCSException.Create(Lines.Text);
    for i := 0 to Lines.Count - 1 do begin
      // put the current one first
      if (i > 0) and Lines[i].StartsWith('*') then begin
        Lines.Insert(0, Lines[i].Substring(2));
        Lines.Delete(i);
      end else begin
        Lines[i] := Lines[i].Substring(2);
      end;
    end;
    SetLength(Result, Lines.Count);
    for i := 0 to Lines.Count - 1 do begin
      Result[i] := Lines[i];
    end;
  finally
    Lines.Free;
  end;
end;

function TVCSFossil.GetExecutable: string;
begin
  Result := 'fossil.exe';
end;
︙︙
Changes to src/vcsinfo.VCSClient.pas.
︙︙
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262

  StartupInfo.hStdError := PipeWrite;
  UniqueString(CommandLine); // CommandLine must be in a writable memory block
  ProcessInfo.dwProcessId := 0;
  try
    if CurrentDir <> '' then
      PCurrentDir := PChar(CurrentDir)
    else
      PCurrentDir := nil;
    if CreateProcess(nil, PChar(CommandLine), nil, nil, True, NORMAL_PRIORITY_CLASS,
      nil, PCurrentDir, StartupInfo, ProcessInfo) then
    begin
      CloseHandle(PipeWrite);
      PipeWrite := 0;
      if AbortPtr <> nil then
        {$IFDEF FPC}








|








248
249
250
251
252
253
254
255
256
257
258
259
260
261
262

  StartupInfo.hStdError := PipeWrite;
  UniqueString(CommandLine); // CommandLine must be in a writable memory block
  ProcessInfo.dwProcessId := 0;
  try
    if CurrentDir <> '' then
      PCurrentDir := PChar(CurrentDir)
    else
      PCurrentDir := PChar(FRoot);
    if CreateProcess(nil, PChar(CommandLine), nil, nil, True, NORMAL_PRIORITY_CLASS,
      nil, PCurrentDir, StartupInfo, ProcessInfo) then
    begin
      CloseHandle(PipeWrite);
      PipeWrite := 0;
      if AbortPtr <> nil then
        {$IFDEF FPC}
︙︙
Powered by Fossil · RSS · Site map