Check-in [da9ee3161e]

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:da9ee3161e579202670869162f8ec72a36ef0b30
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