Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Added CreateProcess wrapper. Added first UI methods for Fossil. |
|---|---|
| Timelines: | family | ancestors | descendants | both | feature/rewrite-multi-async |
| Files: | files | file ages | folders |
| SHA1: |
da9ee3161e579202670869162f8ec72a |
| User & Date: | tinus 2016-02-22 19:28:31 |
Context
|
2016-02-25
| ||
| 20:36 | Implemented many methods for Fossil. Turned several methods into class methods. Leaf check-in: e7b75b1a22 user: tinus tags: feature/rewrite-multi-async | |
|
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 | |
Changes
Changes to src/vcsinfo.Fossil.pas.
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
...
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
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;
................................................................................
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
|
|
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
|
>
|
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
...
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
181
182
183
184
185
|
function SwitchToBranchUI(const BranchName: string): boolean; override;
procedure ProcessRename(const OldName, NewName: string); override;
end;
implementation
uses
System.Classes, System.SysUtils,
Vcl.Forms, Vcl.Controls, Vcl.Dialogs;
{ TVCSFossil }
constructor TVCSFossil.Create(const APath: string);
begin
inherited;
................................................................................
raise EVCSException.Create(Lines.Text);
finally
Lines.Free;
end;
end;
procedure TVCSFossil.ShowRemoteStatusUI;
var
Output: string;
RetVal: Cardinal;
MsgType: TMsgDlgType;
begin
Screen.Cursor := crHourGlass;
try
RetVal := ExecuteCmd('fossil sync -autourl', Output);
if RetVal = 0 then
MsgType := mtInformation
else
MsgType := mtError;
finally
Screen.Cursor := crDefault;
end;
TaskMessageDlg(FRoot, Output, MsgType, [mbOK], 0);
end;
procedure TVCSFossil.ShowRepositoryUI;
begin
if not CreateProcess('fossil ui', FRoot) then
RaiseLastOSError;
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
|
Changes to src/vcsinfo.VCSClient.pas.
36 37 38 39 40 41 42 43 44 45 46 47 48 49 ... 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 ... 355 356 357 358 359 360 361 362 363 364 365 366 367 368 |
AbortPtr: PBoolean = nil;
const CurrentDir: string = ''): Cardinal; overload;
function ExecuteCmd(const CommandLine: string;
var Output: string;
RawOutput: Boolean = False;
AbortPtr: PBoolean = nil;
const CurrentDir: string = ''): Cardinal; overload;
function GetExecutable: string; virtual; abstract;
function GetUIExecutable: string; virtual; abstract;
function GetTitle: string; virtual;
function GetCurrentBranch: string; virtual;
public
constructor Create(const APath: string);
................................................................................
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}
AbortPtr^ := 0;
................................................................................
Dummy: string;
begin
Dummy := '';
Result := InternalExecute(CommandLine, Dummy, OutputLineCallback, RawOutput, AbortPtr, CurrentDir);
end;
{$ENDREGION}
class function TVCSClient.CreateForPath(const APath: string): TVCSClient;
var
VCSClass: TVCSClientClass;
RootPath: string;
begin
|
> > > | > > > > > > > > > > > > > > > > > > > > > > > > > > |
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 ... 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 ... 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 397 |
AbortPtr: PBoolean = nil;
const CurrentDir: string = ''): Cardinal; overload;
function ExecuteCmd(const CommandLine: string;
var Output: string;
RawOutput: Boolean = False;
AbortPtr: PBoolean = nil;
const CurrentDir: string = ''): Cardinal; overload;
function CreateProcess(const ACommand: string; const ACurrentDir: string = ''; const AShow: boolean = False): boolean;
function GetExecutable: string; virtual; abstract;
function GetUIExecutable: string; virtual; abstract;
function GetTitle: string; virtual;
function GetCurrentBranch: string; virtual;
public
constructor Create(const APath: string);
................................................................................
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 Winapi.Windows.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}
AbortPtr^ := 0;
................................................................................
Dummy: string;
begin
Dummy := '';
Result := InternalExecute(CommandLine, Dummy, OutputLineCallback, RawOutput, AbortPtr, CurrentDir);
end;
{$ENDREGION}
function TVCSClient.CreateProcess(const ACommand: string; const ACurrentDir: string = ''; const AShow: boolean = False): boolean;
var
SUI: TStartupInfo;
Command: string;
ProcInfo: TProcessInformation;
begin
try
SUI := Default(TStartupInfo);
SUI.cb := SizeOf(SUI);
if not AShow then begin
SUI.dwFlags := STARTF_USESHOWWINDOW;
SUI.wShowWindow := SW_MINIMIZE;
end;
Command := ACommand;
UniqueString(Command);
Result := Winapi.Windows.CreateProcess(nil, PChar(Command), nil, nil, False,
CREATE_UNICODE_ENVIRONMENT,
nil,
PChar(ACurrentDir),
SUI, ProcInfo);
except
Result := False;
end;
end {CreateProcess};
class function TVCSClient.CreateForPath(const APath: string): TVCSClient;
var
VCSClass: TVCSClientClass;
RootPath: string;
begin
|