source: trunk/Core.pas

Last change on this file was 24, checked in by chronos, 4 days ago
  • Fixed: Test cases executed with FormTests form from Common package.
File size: 11.0 KB
Line 
1unit Core;
2
3interface
4
5uses
6 Classes, SysUtils, XMLConf, LazFileUtils, ActnList, Controls, VCS, Project,
7 LastOpenedList, Forms, Dialogs, Menus, Backend,
8 FormMain;
9
10type
11
12 { TCore }
13
14 TCore = class(TDataModule)
15 AAbout: TAction;
16 ACommandUpdate: TAction;
17 ACommandCleanup: TAction;
18 ACommandCommit: TAction;
19 ACommandStatus: TAction;
20 ARepositoryCreate: TAction;
21 AProjectGroupSaveAs: TAction;
22 AProjectGroupSave: TAction;
23 AProjectGroupClose: TAction;
24 AProjectGroupOpen: TAction;
25 AProjectGroupNew: TAction;
26 AViewTest: TAction;
27 AProjectCheckout: TAction;
28 AProjectClose: TAction;
29 ActionList1: TActionList;
30 AHelp: TAction;
31 AProjectOpen: TAction;
32 AQuit: TAction;
33 ASettings: TAction;
34 AViewFavorites: TAction;
35 ImageList1: TImageList;
36 LastOpenedListProject: TLastOpenedList;
37 LastOpenedListNewDir: TLastOpenedList;
38 LastOpenedListProjectGroup: TLastOpenedList;
39 LastOpenedListRepoURL: TLastOpenedList;
40 OpenDialog1: TOpenDialog;
41 SaveDialog1: TSaveDialog;
42 XMLConfig1: TXMLConfig;
43 procedure ACommandCleanupExecute(Sender: TObject);
44 procedure ACommandCommitExecute(Sender: TObject);
45 procedure ACommandUpdateExecute(Sender: TObject);
46 procedure AProjectCheckoutExecute(Sender: TObject);
47 procedure AProjectCloseExecute(Sender: TObject);
48 procedure AProjectGroupCloseExecute(Sender: TObject);
49 procedure AProjectGroupNewExecute(Sender: TObject);
50 procedure AProjectGroupOpenExecute(Sender: TObject);
51 procedure AProjectGroupSaveAsExecute(Sender: TObject);
52 procedure AProjectGroupSaveExecute(Sender: TObject);
53 procedure AProjectOpenExecute(Sender: TObject);
54 procedure AQuitExecute(Sender: TObject);
55 procedure ARepositoryCreateExecute(Sender: TObject);
56 procedure ASettingsExecute(Sender: TObject);
57 procedure AViewTestExecute(Sender: TObject);
58 procedure DataModuleCreate(Sender: TObject);
59 procedure DataModuleDestroy(Sender: TObject);
60 procedure LastOpenedListProjectChange(Sender: TObject);
61 procedure LastOpenedListProjectGroupChange(Sender: TObject);
62 private
63 procedure UpdateInterface;
64 procedure RegisterBackends;
65 procedure RegisterBackend(Backend: TBackend);
66 function DetectBackend(Directory: string): TBackend;
67 public
68 Backends: TBackends;
69 Project: TProject;
70 ProjectGroup: TProjectGroup;
71 UserName: string;
72 Email: string;
73 FormMain: TFormMain;
74 procedure LoadConfig;
75 procedure SaveConfig;
76 procedure Init;
77 procedure Done;
78 procedure ProjectOpen(Directory: string);
79 procedure ProjectGroupOpen(FileName: string);
80 end;
81
82var
83 Core: TCore;
84
85
86implementation
87
88{$R *.lfm}
89
90uses
91 FormBrowse, FormSettings, FormCommit, FormCheckout, FormTests,
92 Subversion, Bazaar, CVS, Git, FormProjectGroup, Test;
93
94{ TCore }
95
96procedure TCore.AQuitExecute(Sender: TObject);
97begin
98 FormMain.Close;
99 Application.Terminate;
100end;
101
102procedure TCore.ARepositoryCreateExecute(Sender: TObject);
103var
104 TempProject: TProject;
105begin
106 {
107 if LastOpenedListRepoURL.Items.Count > 0 then
108 FormRepoCreate.EditURL.Text := LastOpenedListRepoURL.Items[0];
109 if LastOpenedListNewDir.Items.Count > 0 then
110 FormRepoCreate.EditDir.Text := LastOpenedListNewDir.Items[0];
111 if FormCheckout.ShowModal = mrOk then begin
112 LastOpenedListRepoURL.AddItem(FormCheckout.EditURL.Text);
113 LastOpenedListNewDir.AddItem(FormCheckout.EditDir.Text);
114 TempProject := TProject.Create;
115 try
116 TempProject.Backend := TBackend(FormRepoCreate.ComboBox1.Items.Objects[FormRepoCreate.ComboBox1.ItemIndex]);
117 TempProject.Directory := FormRepoCreate.EditDir.Text;
118 TempProject.RepositoryURL := FormRepoCreate.EditURL.Text;
119 TempProject.Repository.Init;
120 finally
121 TempProject.Free;
122 end;
123 end;
124 }
125end;
126
127procedure TCore.ASettingsExecute(Sender: TObject);
128var
129 FormSettings: TFormSettings;
130begin
131 FormSettings := TFormSettings.Create(nil);
132 try
133 FormSettings.Load(XMLConfig1);
134 if FormSettings.ShowModal = mrOk then begin
135 FormSettings.Save(XMLConfig1);
136 end;
137 finally
138 FormSettings.Free;
139 end;
140end;
141
142procedure TCore.AViewTestExecute(Sender: TObject);
143begin
144 with TFormTests.Create(nil) do
145 try
146 TestCases := InitTestCases;
147 try
148 ShowModal;
149 finally
150 TestCases.Free;
151 end;
152 finally
153 Free;
154 end;
155end;
156
157procedure TCore.DataModuleCreate(Sender: TObject);
158begin
159 Backends := TBackends.Create;
160 Project := nil;
161
162 Application.CreateForm(TFormMain, FormMain);
163 FormMain.Show;
164end;
165
166procedure TCore.DataModuleDestroy(Sender: TObject);
167begin
168 FreeAndNil(Project);
169 FreeAndNil(Backends);
170end;
171
172procedure TCore.LastOpenedListProjectChange(Sender: TObject);
173begin
174 LastOpenedListProject.LoadToMenuItem(FormMain.MenuItemOpenRecent, FormMain.OpenRecentExecute);
175end;
176
177procedure TCore.LastOpenedListProjectGroupChange(Sender: TObject);
178begin
179 LastOpenedListProjectGroup.LoadToMenuItem(FormMain.MenuItemRecentProjectGroup, FormMain.ProjectGroupOpenRecentExecute);
180end;
181
182procedure TCore.UpdateInterface;
183begin
184 AProjectClose.Enabled := Assigned(Project);
185 AProjectGroupClose.Enabled := Assigned(ProjectGroup);
186 AProjectGroupSave.Enabled := Assigned(ProjectGroup);
187 AProjectGroupSaveAs.Enabled := Assigned(ProjectGroup);
188 FormMain.UpdateInterface;
189end;
190
191procedure TCore.RegisterBackends;
192begin
193 RegisterBackend(TBackendSubversion.Create);
194 RegisterBackend(TBackendBazaar.Create);
195 RegisterBackend(TBackendCVS.Create);
196 RegisterBackend(TBackendGit.Create);
197end;
198
199procedure TCore.RegisterBackend(Backend: TBackend);
200begin
201 Backends.Add(Backend);
202end;
203
204function TCore.DetectBackend(Directory: string): TBackend;
205var
206 I: Integer;
207begin
208 I := 0;
209 while (I < Backends.Count) and (not Backends[I].IsWorkingCopy(Directory)) do Inc(I);
210 if I < Backends.Count then Result := Backends[I]
211 else Result := nil;
212end;
213
214procedure TCore.LoadConfig;
215begin
216 LastOpenedListProject.LoadFromXMLConfig(XMLConfig1, 'LastOpenedProjects');
217 LastOpenedListRepoURL.LoadFromXMLConfig(XMLConfig1, 'LastOpenedRepoURL');
218 LastOpenedListNewDir.LoadFromXMLConfig(XMLConfig1, 'LastOpenedNewDir');
219 LastOpenedListProjectGroup.LoadFromXMLConfig(XMLConfig1, 'LastOpenedListProjectGroup');
220 UserName := XMLConfig1.GetValue('UserName', '');
221 Email := XMLConfig1.GetValue('Email', '');
222end;
223
224procedure TCore.SaveConfig;
225begin
226 LastOpenedListProject.SaveToXMLConfig(XMLConfig1, 'LastOpenedProjects');
227 LastOpenedListRepoURL.SaveToXMLConfig(XMLConfig1, 'LastOpenedRepoURL');
228 LastOpenedListNewDir.SaveToXMLConfig(XMLConfig1, 'LastOpenedNewDir');
229 LastOpenedListProjectGroup.SaveToXMLConfig(XMLConfig1, 'LastOpenedListProjectGroup');
230 XMLConfig1.SetValue('UserName', UserName);
231 XMLConfig1.SetValue('Email', Email);
232 XmlConfig1.Flush;
233end;
234
235procedure TCore.Init;
236begin
237 RegisterBackends;
238 XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';
239 ForceDirectories(ExtractFileDir(XMLConfig1.Filename));
240 LoadConfig;
241 if (LastOpenedListProject.Items.Count > 0) and DirectoryExists(LastOpenedListProject.Items[0]) then
242 ProjectOpen(LastOpenedListProject.Items[0]);
243end;
244
245procedure TCore.Done;
246begin
247 SaveConfig;
248end;
249
250procedure TCore.ProjectOpen(Directory: string);
251begin
252 AProjectClose.Execute;
253 Project := TProject.Create;
254 Project.Backend := DetectBackend(Directory);
255 Project.WorkingCopy.UserName := Core.UserName;
256 Project.WorkingCopy.Email := Core.Email;
257 if Assigned(Project.Backend) then begin
258 Project.Directory := Directory;
259 UpdateInterface;
260 FormMain.FormBrowse.Directory := Project.Directory;
261 FormMain.FormBrowse.ReloadList;
262 LastOpenedListProject.AddItem(Project.Directory);
263 end else ShowMessage('Directory ''' + Directory + ''' not recognized as working copy of any of supported VCS systems');
264end;
265
266procedure TCore.ProjectGroupOpen(FileName: string);
267begin
268 AProjectGroupClose.Execute;
269 ProjectGroup := TProjectGroup.Create;
270 ProjectGroup.FileName := FileName;
271 UpdateInterface;
272 FormMain.FormProjectGroup.ReloadTree;
273 LastOpenedListProjectGroup.AddItem(FileName);
274end;
275
276procedure TCore.AProjectOpenExecute(Sender: TObject);
277var
278 Dir: string;
279 OldDir: string;
280begin
281 if Assigned(Project) then OldDir := Project.Directory
282 else OldDir := '';
283 if SelectDirectory('Open project', OldDir, Dir) then begin
284 ProjectOpen(Dir);
285 end;
286end;
287
288procedure TCore.AProjectCloseExecute(Sender: TObject);
289begin
290 FreeAndNil(Project);
291 FormMain.FormBrowse.Directory := '';
292 FormMain.FormBrowse.ReloadList;
293 UpdateInterface;
294end;
295
296procedure TCore.AProjectGroupCloseExecute(Sender: TObject);
297begin
298 FreeAndNil(ProjectGroup);
299 UpdateInterface;
300 FormMain.FormProjectGroup.ReloadTree;
301end;
302
303procedure TCore.AProjectGroupNewExecute(Sender: TObject);
304begin
305 AProjectClose.Execute;
306 ProjectGroup := TProjectGroup.Create;
307 ProjectGroup.FileName := 'New project group.vcgrp';
308 UpdateInterface;
309 FormMain.FormProjectGroup.ReloadTree;
310end;
311
312procedure TCore.AProjectGroupOpenExecute(Sender: TObject);
313begin
314 if LastOpenedListProjectGroup.Items.Count > 0 then
315 OpenDialog1.FileName := LastOpenedListProjectGroup.Items[0];
316 if OpenDialog1.Execute then begin
317 AProjectClose.Execute;
318 ProjectGroupOpen(OpenDialog1.FileName);
319 end;
320end;
321
322procedure TCore.AProjectGroupSaveAsExecute(Sender: TObject);
323begin
324 SaveDialog1.FileName := ProjectGroup.FileName;
325 if SaveDialog1.Execute then begin
326 ProjectGroup.SaveToFile(SaveDialog1.FileName);
327 UpdateInterface;
328 end;
329end;
330
331procedure TCore.AProjectGroupSaveExecute(Sender: TObject);
332begin
333 if FileExists(ProjectGroup.FileName) then ProjectGroup.SaveToFile(ProjectGroup.FileName)
334 else AProjectGroupSaveAs.Execute;
335end;
336
337procedure TCore.ACommandUpdateExecute(Sender: TObject);
338begin
339 Project.WorkingCopy.Update;
340end;
341
342procedure TCore.AProjectCheckoutExecute(Sender: TObject);
343var
344 TempProject: TProject;
345 FormCheckout: TFormCheckout;
346begin
347 FormCheckout := TFormCheckout.Create(nil);
348 try
349 if LastOpenedListRepoURL.Items.Count > 0 then
350 FormCheckout.EditURL.Text := LastOpenedListRepoURL.Items[0];
351 if LastOpenedListNewDir.Items.Count > 0 then
352 FormCheckout.EditDir.Text := LastOpenedListNewDir.Items[0];
353 if FormCheckout.ShowModal = mrOk then begin
354 LastOpenedListRepoURL.AddItem(FormCheckout.EditURL.Text);
355 LastOpenedListNewDir.AddItem(FormCheckout.EditDir.Text);
356 TempProject := TProject.Create;
357 try
358 TempProject.Backend := TBackend(FormCheckout.ComboBox1.Items.Objects[FormCheckout.ComboBox1.ItemIndex]);
359 TempProject.Directory := FormCheckout.EditDir.Text;
360 TempProject.RepositoryURL := FormCheckout.EditURL.Text;
361 TempProject.WorkingCopy.Checkout;
362 finally
363 TempProject.Free;
364 end;
365 ProjectOpen(FormCheckout.EditDir.Text);
366 end;
367 finally
368 FormCheckout.Free;
369 end;
370end;
371
372procedure TCore.ACommandCleanupExecute(Sender: TObject);
373begin
374 Project.WorkingCopy.Cleanup;
375end;
376
377procedure TCore.ACommandCommitExecute(Sender: TObject);
378var
379 FormCommit: TFormCommit;
380begin
381 FormCommit := TFormCommit.Create(nil);
382 try
383 if FormCommit.ShowModal = mrOk then begin
384 Project.WorkingCopy.Commit(FormCommit.MemoMessage.Lines.Text);
385 end;
386 finally
387 FormCommit.Free;
388 end;
389end;
390
391end.
392
Note: See TracBrowser for help on using the repository browser.