RAD Studio VCS Info
Check-in [5cad66e9d6]
Login
HomeTimelineBranchesTagsTicketsWiki

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

Overview
Comment:Implemented GUI-less fossil methods.
Timelines: family | ancestors | descendants | both | feature/rewrite-multi-async
Files: files | file ages | folders
SHA1: 5cad66e9d67c06302de224cb71a68687cf90e80f
User & Date: tinus 2016-02-22 19:09:32
Context
2016-02-22
19:28
Added CreateProcess wrapper. Added first UI methods for Fossil. check-in: da9ee3161e user: tinus tags: feature/rewrite-multi-async
19:09
Implemented GUI-less fossil methods. check-in: 5cad66e9d6 user: tinus tags: feature/rewrite-multi-async
18:52
Encode all source files in UTF-8. check-in: 5ca0dccf2c user: tinus tags: feature/rewrite-multi-async
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/vcsinfo.Fossil.pas. 

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
..
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
..
93
94
95
96
97
98
99
100


101
102









103
104
105


106
107









108
109
110


111
112

113
114
115
116
117
118
119
120


121
122








123

124
125
126
127
128
129
130
131
132
133
134
135


136
137


138
139
140
141
142
143
144
145
146
147

    destructor  Destroy; override;

    function  GetBranches: TArray<string>; override;

    function  GetIncoming: integer; override;
    function  GetOutgoing: integer; override;

    function  GetPendingFiles: integer; override;
    function  GetUntrackedFiles: Integer; override;
    function  GetStatus: TArray<string>; override;

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

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

implementation
uses
................................................................................
  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
................................................................................

function TVCSFossil.GetOutgoing: integer;
begin
  {$MESSAGE WARN 'TODO: if remote-url is off, or autosync is on, then 0; otherwise -1'}
  Result := -1;
end;

function TVCSFossil.GetPendingFiles: integer;


begin
  {$MESSAGE WARN 'TODO: fossil changes'}









end;

function TVCSFossil.GetStatus: TArray<string>;


begin
  {$MESSAGE WARN 'TODO: fossil status'}









end;

function TVCSFossil.GetTitle: string;


begin
  {$MESSAGE WARN 'TODO: fossil sqlite3 "SELECT value FROM config WHERE name=‘project-name’"'}

end;

function TVCSFossil.GetUIExecutable: string;
begin
  Result := '';
end;

function TVCSFossil.GetUntrackedFiles: Integer;


begin
  {$MESSAGE WARN 'TODO: fossil extras'}








end;


procedure TVCSFossil.ShowRemoteUI;
begin
  {$MESSAGE WARN 'TODO: fossil sync -autourl; show results'}
end;

procedure TVCSFossil.ShowRepositoryUI;
begin
  {$MESSAGE WARN 'TODO: fossil ui'}
end;

procedure TVCSFossil.ProcessRename(const OldName, NewName: string);


begin
  {$MESSAGE WARN 'TODO: fossil rename --soft "OldName" "NewName"'}


end;

procedure TVCSFossil.ShowStatusUI;
begin
  {$MESSAGE WARN 'TODO: fossil gdiff'}
end;

function TVCSFossil.SwitchToBranchUI(const BranchName: string): boolean;
begin
  // TODO: see old VCSInfoMenuWzrd: try fossil checkout first, then dialog with








|
|



|
|







 







|









|
<
<
<







 







|
>
>

<
>
>
>
>
>
>
>
>
>



>
>

<
>
>
>
>
>
>
>
>
>



>
>

|
>







|
>
>

<
>
>
>
>
>
>
>
>
|
>

|










>
>

<
>
>


|








17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
..
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
..
90
91
92
93
94
95
96
97
98
99
100

101
102
103
104
105
106
107
108
109
110
111
112
113
114
115

116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168

169
170
171
172
173
174
175
176
177
178
179
180

    destructor  Destroy; override;

    function  GetBranches: TArray<string>; override;

    function  GetIncoming: integer; override;
    function  GetOutgoing: integer; override;

    function  CountPendingFiles: integer; override;
    function  CountUntrackedFiles: Integer; override;
    function  GetStatus: TArray<string>; override;

    procedure ShowRepositoryUI; override;
    procedure ShowRemoteStatusUI; override;
    procedure ShowLocalStatusUI; override;
    function  SwitchToBranchUI(const BranchName: string): boolean; override;

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

implementation
uses
................................................................................
  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.Trim);
    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;
    Result := Lines.ToStringArray;



  finally
    Lines.Free;
  end;
end;

function TVCSFossil.GetExecutable: string;
begin
................................................................................

function TVCSFossil.GetOutgoing: integer;
begin
  {$MESSAGE WARN 'TODO: if remote-url is off, or autosync is on, then 0; otherwise -1'}
  Result := -1;
end;

function TVCSFossil.CountPendingFiles: integer;
var
  Lines: TStringList;
begin

  Lines := TStringList.Create;
  try
    if 0 = ExecuteCmd('fossil changes', Lines.Append) then
      Result := Lines.Count
    else
      raise EVCSException.Create(Lines.Text.Trim);
  finally
    Lines.Free;
  end;
end;

function TVCSFossil.GetStatus: TArray<string>;
var
  Lines: TStringList;
begin

  Lines := TStringList.Create;
  try
    if 0 = ExecuteCmd('fossil status', Lines.Append) then
      Result := Lines.ToStringArray
    else
      raise EVCSException.Create(Lines.Text.Trim);
  finally
    Lines.Free;
  end;
end;

function TVCSFossil.GetTitle: string;
var
  Lines: TStringList;
begin
  if 0 <> ExecuteCmd('fossil sqlite3 "SELECT value FROM config WHERE name=''project-name''"', Result) then
    raise EVCSException.Create(Result);
end;

function TVCSFossil.GetUIExecutable: string;
begin
  Result := '';
end;

function TVCSFossil.CountUntrackedFiles: Integer;
var
  Lines: TStringList;
begin

  Lines := TStringList.Create;
  try
    if 0 = ExecuteCmd('fossil extras', Lines.Append) then
      Result := Lines.Count
    else
      raise EVCSException.Create(Lines.Text);
  finally
    Lines.Free;
  end;
end;

procedure TVCSFossil.ShowRemoteStatusUI;
begin
  {$MESSAGE WARN 'TODO: fossil sync -autourl; show results'}
end;

procedure TVCSFossil.ShowRepositoryUI;
begin
  {$MESSAGE WARN 'TODO: fossil ui'}
end;

procedure TVCSFossil.ProcessRename(const OldName, NewName: string);
var
  Text: string;
begin

  if 0 <> ExecuteCmd(Format('fossil rename --soft "%s" "%s"', [OldName, NewName]), Text) then
    raise EVCSException.Create(Text);
end;

procedure TVCSFossil.ShowLocalStatusUI;
begin
  {$MESSAGE WARN 'TODO: fossil gdiff'}
end;

function TVCSFossil.SwitchToBranchUI(const BranchName: string): boolean;
begin
  // TODO: see old VCSInfoMenuWzrd: try fossil checkout first, then dialog with

Changes to src/vcsinfo.VCSClient.pas. 

50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70

    destructor  Destroy; override;

    function  GetBranches: TArray<string>; virtual; abstract;

    function  GetIncoming: integer; virtual; abstract;
    function  GetOutgoing: integer; virtual; abstract;

    function  GetPendingFiles: integer; virtual; abstract;
    function  GetUntrackedFiles: Integer; virtual; abstract;
    function  GetStatus: TArray<string>; virtual; abstract;

    procedure ShowRepositoryUI; virtual; abstract;
    procedure ShowRemoteUI; virtual; abstract;
    procedure ShowStatusUI; virtual; abstract;
    function  SwitchToBranchUI(const BranchName: string): boolean; virtual; abstract;

    procedure ProcessRename(const OldName, NewName: string); virtual; abstract;

    property Executable: string   read GetExecutable;
    property UIExecutable: string read GetUIExecutable;
    property Root: string         read FRoot;








|
|



|
|








50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70

    destructor  Destroy; override;

    function  GetBranches: TArray<string>; virtual; abstract;

    function  GetIncoming: integer; virtual; abstract;
    function  GetOutgoing: integer; virtual; abstract;

    function  CountPendingFiles: integer; virtual; abstract;
    function  CountUntrackedFiles: Integer; virtual; abstract;
    function  GetStatus: TArray<string>; virtual; abstract;

    procedure ShowRepositoryUI; virtual; abstract;
    procedure ShowRemoteStatusUI; virtual; abstract;
    procedure ShowLocalStatusUI; virtual; abstract;
    function  SwitchToBranchUI(const BranchName: string): boolean; virtual; abstract;

    procedure ProcessRename(const OldName, NewName: string); virtual; abstract;

    property Executable: string   read GetExecutable;
    property UIExecutable: string read GetUIExecutable;
    property Root: string         read FRoot;

Powered by Fossil · RSS · Site map