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 |