Changeset 13


Ignore:
Timestamp:
May 30, 2015, 1:02:36 PM (10 years ago)
Author:
chronos
Message:
  • Added: New test form where general functionality of selected backend can be tested.
  • Added: Basic git backend implementation.
  • Added: Project group form and ability to open/save group of projects as configuration to XML file.
Location:
trunk
Files:
6 added
16 edited

Legend:

Unmodified
Added
Removed

  • trunk/Backends/Bazaar/UBazaar.pas

    r10 r13  
    2020
    2121  TBazaar = class(TWorkingCopy)
     22  private
    2223  protected
    2324    procedure Execute(Parameters: array of string);
    … …  
    3031    procedure Merge; override;
    3132    procedure Add(FileName: string); override;
     33    procedure Remove(FileName: string); override;
    3234  end;
    3335
     36  { TRepositoryBazaar }
     37
     38  TRepositoryBazaar = class(TRepository)
     39  protected
     40    procedure Execute(Parameters: array of string);
     41  public
     42    procedure Init; override;
     43  end;
     44
     45
    3446implementation
     47
     48{ TRepositoryBazaar }
     49
     50procedure TRepositoryBazaar.Execute(Parameters: array of string);
     51begin
     52  ExecuteProcess('/usr/bin/bzr', Parameters);
     53end;
     54
     55procedure TRepositoryBazaar.Init;
     56begin
     57  Execute(['init', Path]);
     58end;
    3559
    3660{ TBazaar }
    … …  
    76100end;
    77101
     102procedure TBazaar.Remove(FileName: string);
     103begin
     104  Execute(['remove', FileName]);
     105end;
     106
    78107{ TBackendBazaar }
    79108
    … …  
    81110begin
    82111  Name := 'Bazaar';
     112  HomePage := 'http://bazaar.canonical.com/';
    83113  WorkingCopyClass := TBazaar;
    84114end;

  • trunk/Backends/CVS/UCVS.pas

    r10 r13  
    3131    procedure Merge; override;
    3232    procedure Add(FileName: string); override;
     33    procedure Remove(FileName: string); override;
    3334  end;
    3435
     36  { TRepositoryCVS }
     37
     38  TRepositoryCVS = class(TRepository)
     39  protected
     40    procedure Execute(Parameters: array of string);
     41  public
     42    procedure Init; override;
     43  end;
     44
     45
    3546implementation
     47
     48{ TRepositoryCVS }
     49
     50procedure TRepositoryCVS.Execute(Parameters: array of string);
     51begin
     52  ExecuteProcess('/usr/bin/cvs', Parameters);
     53end;
     54
     55procedure TRepositoryCVS.Init;
     56begin
     57  Execute(['-d ' + GetCurrentDir + DirectorySeparator + Path, 'init']);
     58end;
    3659
    3760{ TBackendCVS }
    … …  
    4063begin
    4164  Name := 'CVS';
     65  HomePage := 'http://www.nongnu.org/cvs/';
    4266  WorkingCopyClass := TCVS;
     67  RepositoryClass := TRepositoryCVS;
    4368end;
    4469
    … …  
    5277procedure TCVS.Execute(Parameters: array of string);
    5378begin
     79  EnvVars.Values['CVSROOT'] := GetCurrentDir + DirectorySeparator + Path;
    5480  ExecuteProcess('/usr/bin/cvs', Parameters);
    5581end;
    … …  
    93119end;
    94120
     121procedure TCVS.Remove(FileName: string);
     122begin
     123  DeleteFile(FileName);
     124  Execute(['rm', FileName]);
     125end;
     126
    95127end.
    96128

  • trunk/Backends/Subversion/USubversion.pas

    r11 r13  
    3131    procedure Merge; override;
    3232    procedure Add(FileName: string); override;
     33    procedure Remove(FileName: string); override;
    3334    procedure GetLog(FileName: string; Log: TLogList); override;
    3435  end;
    3536
     37  { TRepositorySubversion }
     38
     39  TRepositorySubversion = class(TRepository)
     40  protected
     41    procedure Execute(Parameters: array of string);
     42  public
     43    procedure Init; override;
     44  end;
     45
    3646implementation
     47
     48{ TRepositorySubversion }
     49
     50procedure TRepositorySubversion.Execute(Parameters: array of string);
     51begin
     52  ExecuteProcess('/usr/bin/svnadmin', Parameters);
     53end;
     54
     55procedure TRepositorySubversion.Init;
     56begin
     57  Execute(['create', Path]);
     58end;
    3759
    3860{ TBackendSubversion }
    … …  
    4163begin
    4264  Name := 'Subversion';
     65  HomePage := 'https://subversion.apache.org/';
    4366  WorkingCopyClass := TSubversion;
     67  RepositoryClass := TRepositorySubversion;
    4468end;
    4569
    … …  
    92116end;
    93117
     118procedure TSubversion.Remove(FileName: string);
     119begin
     120  Execute(['remove', FileName]);
     121end;
     122
    94123procedure TSubversion.GetLog(FileName: string; Log: TLogList);
    95124var

  • trunk/Forms/UFormBrowse.lfm

    r11 r13  
    11object FormBrowse: TFormBrowse
    2   Left = 554
     2  Left = 952
    33  Height = 526
    4   Top = 269
     4  Top = 287
    55  Width = 722
    66  Caption = 'Browse'

  • trunk/Forms/UFormConsole.pas

    r8 r13  
    3131    Parameters: TStringList;
    3232    WorkingDir: string;
    33     Environment: string;
     33    EnvironmentVariables: TStringList;
    3434    Aborted: Boolean;
    3535    Log: TStringList;
    … …  
    5050  Parameters := TStringList.Create;
    5151  Log := TStringList.Create;
     52  EnvironmentVariables := TStringList.Create;
    5253end;
    5354
    5455procedure TFormConsole.FormDestroy(Sender: TObject);
    5556begin
     57  EnvironmentVariables.Free;
    5658  Log.Free;
    5759  Parameters.Free;
    … …  
    101103    if WorkingDir <> '' then
    102104      Process.CurrentDirectory := WorkingDir;
    103     //WorkingDir := '';
    104     if Environment <> '' then
    105       Process.Environment.Text := Environment;
    106     Environment := '';
     105    Process.Environment.Assign(EnvironmentVariables);
     106    Process.Parameters.Assign(Parameters);
    107107    Process.Executable := Executable;
    108     Process.Parameters.Assign(Parameters);
    109     //for I := 0 to Process.Parameters.Count - 1 do
    110     //  ShowMessage('"' + Process.Parameters[I] + '"');
    111     //Process.CommandLine := Executable + ' checkout http://svn.zdechov.net/svn/xtactics /home/chronos/Smazat/svn3';
    112     //Process.Parameters.Clear;
    113     //Process.Parameters.Add('checkout');
    114     //Process.Parameters.Add('http://svn.zdechov.net/svn/xtactics');
    115     //Process.Parameters.Add('/home/chronos/Smazat/svn3');
    116     //Process.Parameters.Add('checkout');
    117     //Process.Parameters.Add('dasd');;
    118     //Process.CommandLine := Executable + ' ' + Parameters.Text;
    119108    CommandLine := Executable + ' ' + StringReplace(Parameters.Text, LineEnding, ' ', [rfReplaceAll]);
    120109    if CommandLine[Length(CommandLine)] = LineEnding then

  • trunk/Forms/UFormMain.lfm

    r8 r13  
    11object FormMain: TFormMain
    2   Left = 340
    3   Height = 497
    4   Top = 152
    5   Width = 667
     2  Left = 416
     3  Height = 568
     4  Top = 329
     5  Width = 939
    66  Caption = 'VCSCommander'
    7   ClientHeight = 468
    8   ClientWidth = 667
     7  ClientHeight = 539
     8  ClientWidth = 939
    99  Menu = MainMenu1
    1010  OnActivate = FormActivate
    … …  
    1717    Height = 26
    1818    Top = 0
    19     Width = 667
     19    Width = 939
    2020    Caption = 'ToolBarMain'
     21    Images = Core.ImageList1
    2122    ParentShowHint = False
    2223    ShowHint = True
    2324    TabOrder = 0
     25    object ToolButton1: TToolButton
     26      Left = 1
     27      Top = 2
     28      Action = Core.AProjectCheckout
     29    end
     30    object ToolButton2: TToolButton
     31      Left = 24
     32      Top = 2
     33      Action = Core.AProjectOpen
     34    end
     35    object ToolButton3: TToolButton
     36      Left = 47
     37      Top = 2
     38      Action = Core.AProjectClose
     39    end
    2440  end
    2541  object StatusBar1: TStatusBar
    2642    Left = 0
    2743    Height = 29
    28     Top = 439
    29     Width = 667
     44    Top = 510
     45    Width = 939
    3046    Panels = <>
    3147  end
    3248  object MainMenu1: TMainMenu
     49    Images = Core.ImageList1
    3350    left = 232
    3451    top = 88
    3552    object MenuItemFile: TMenuItem
    36       Caption = 'File'
     53      Caption = 'Working copy'
    3754      object MenuItem17: TMenuItem
    3855        Action = Core.AProjectCheckout
    … …  
    5269      object MenuItemQuit: TMenuItem
    5370        Action = Core.AQuit
     71      end
     72    end
     73    object MenuItem19: TMenuItem
     74      Caption = 'Project group'
     75      object MenuItem20: TMenuItem
     76        Action = Core.AProjectGroupNew
     77      end
     78      object MenuItem21: TMenuItem
     79        Action = Core.AProjectGroupOpen
     80      end
     81      object MenuItemRecentProjectGroup: TMenuItem
     82        Caption = 'Open recent'
     83      end
     84      object MenuItem23: TMenuItem
     85        Action = Core.AProjectGroupSave
     86      end
     87      object MenuItem25: TMenuItem
     88        Action = Core.AProjectGroupSaveAs
     89      end
     90      object MenuItem24: TMenuItem
     91        Action = Core.AProjectGroupClose
    5492      end
    5593    end
    … …  
    75113      end
    76114    end
     115    object MenuItem15: TMenuItem
     116      Caption = 'Tools'
     117      object MenuItem18: TMenuItem
     118        Action = Core.AViewTest
     119      end
     120    end
    77121    object MenuItem1: TMenuItem
    78122      Caption = 'General'

  • trunk/Forms/UFormMain.pas

    r9 r13  
    11unit UFormMain;
    22
    3 {$mode objfpc}{$H+}
     3{$mode delphi}{$H+}
    44
    55interface
    … …  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
    9   Menus, ActnList;
     9  Menus, ActnList, ExtCtrls;
    1010
    1111type
    … …  
    2121    MenuItem13: TMenuItem;
    2222    MenuItem14: TMenuItem;
     23    MenuItem15: TMenuItem;
    2324    MenuItem16: TMenuItem;
    2425    MenuItem17: TMenuItem;
     26    MenuItem18: TMenuItem;
     27    MenuItem19: TMenuItem;
     28    MenuItem20: TMenuItem;
     29    MenuItem21: TMenuItem;
     30    MenuItemRecentProjectGroup: TMenuItem;
     31    MenuItem23: TMenuItem;
     32    MenuItem24: TMenuItem;
     33    MenuItem25: TMenuItem;
    2534    MenuItemOpenRecent: TMenuItem;
    2635    MenuItem2: TMenuItem;
    … …  
    3645    StatusBar1: TStatusBar;
    3746    ToolBarMain: TToolBar;
     47    ToolButton1: TToolButton;
     48    ToolButton2: TToolButton;
     49    ToolButton3: TToolButton;
    3850    procedure FormActivate(Sender: TObject);
    3951    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    … …  
    4254    Initialized: Boolean;
    4355  public
     56    procedure ProjectGroupOpenRecentExecute(Sender: TObject);
    4457    procedure OpenRecentExecute(Sender: TObject);
    4558    procedure UpdateInterface;
    … …  
    5568
    5669uses
    57   UCore, UFormBrowse;
     70  UCore, UFormBrowse, UFormProjectGroup;
    5871
    5972{ TFormMain }
    … …  
    6679procedure TFormMain.OpenRecentExecute(Sender: TObject);
    6780begin
    68   Core.ProjectOpen(Core.LastOpenedList1.Items[TMenuItem(Sender).MenuIndex]);
     81  Core.ProjectOpen(Core.LastOpenedListProject.Items[TMenuItem(Sender).MenuIndex]);
     82end;
     83
     84procedure TFormMain.ProjectGroupOpenRecentExecute(Sender: TObject);
     85begin
     86  Core.ProjectGroupOpen(Core.LastOpenedListProjectGroup.Items[TMenuItem(Sender).MenuIndex]);
    6987end;
    7088
    … …  
    96114
    97115procedure TFormMain.DockInit;
     116var
     117  NewSplitter: TSplitter;
    98118begin
     119  FormProjectGroup.ManualDock(Self, nil, alLeft);
     120  FormProjectGroup.Align := alLeft;
     121  FormProjectGroup.Show;
     122  NewSplitter := TSplitter.Create(nil);
     123  NewSplitter.ManualDock(Self, nil, alLeft);
     124  NewSplitter.Align := alLeft;
     125  NewSplitter.Left := FormProjectGroup.Width;
     126  NewSplitter.Show;
    99127  FormBrowse.ManualDock(Self, nil, alClient);
    100128  FormBrowse.Align := alClient;

  • trunk/Forms/UFormSettings.lfm

    r7 r13  
    77  ClientHeight = 497
    88  ClientWidth = 686
     9  OnCreate = FormCreate
    910  LCLVersion = '1.5'
    1011  object ButtonCancel: TButton
    … …  
    2627    TabOrder = 1
    2728  end
     29  object Label1: TLabel
     30    Left = 16
     31    Height = 25
     32    Top = 16
     33    Width = 107
     34    Caption = 'User name:'
     35    ParentColor = False
     36  end
     37  object Label2: TLabel
     38    Left = 16
     39    Height = 25
     40    Top = 64
     41    Width = 57
     42    Caption = 'Email:'
     43    ParentColor = False
     44  end
     45  object EditUserName: TEdit
     46    Left = 152
     47    Height = 35
     48    Top = 8
     49    Width = 264
     50    TabOrder = 2
     51  end
     52  object EditEmail: TEdit
     53    Left = 152
     54    Height = 35
     55    Top = 56
     56    Width = 264
     57    TabOrder = 3
     58  end
    2859end

  • trunk/Forms/UFormSettings.pas

    r7 r13  
    66
    77uses
    8   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
     8  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
     9  XMLConf;
    910
    1011type
    … …  
    1516    ButtonCancel: TButton;
    1617    ButtonOk: TButton;
     18    EditUserName: TEdit;
     19    EditEmail: TEdit;
     20    Label1: TLabel;
     21    Label2: TLabel;
     22    procedure FormCreate(Sender: TObject);
    1723  private
    1824    { private declarations }
    1925  public
    20     { public declarations }
     26    procedure Load(XMLConfig: TXMLConfig);
     27    procedure Save(XMLConfig: TXMLConfig);
    2128  end;
    2229
    … …  
    2835{$R *.lfm}
    2936
     37uses
     38  UCore;
     39
     40{ TFormSettings }
     41
     42procedure TFormSettings.FormCreate(Sender: TObject);
     43begin
     44
     45end;
     46
     47procedure TFormSettings.Load(XMLConfig: TXMLConfig);
     48begin
     49  EditUserName.Text := Core.UserName;
     50  EditEmail.Text := Core.Email;
     51end;
     52
     53procedure TFormSettings.Save(XMLConfig: TXMLConfig);
     54begin
     55  Core.UserName := EditUserName.Text;
     56  Core.Email := EditEmail.Text;
     57end;
     58
    3059end.
    3160

  • trunk/UCore.lfm

    r11 r13  
    88  Width = 693
    99  object ActionList1: TActionList
    10     left = 260
    11     top = 172
     10    Images = ImageList1
     11    left = 288
     12    top = 176
    1213    object AQuit: TAction
    1314      Caption = 'Quit'
    … …  
    1819      Caption = 'Settings'
    1920      OnExecute = ASettingsExecute
     21      ShortCut = 121
    2022    end
    2123    object AAbout: TAction
    … …  
    2426    object AHelp: TAction
    2527      Caption = 'Help'
     28      ShortCut = 112
    2629    end
    2730    object AViewFavorites: TAction
    … …  
    2932    end
    3033    object AProjectOpen: TAction
     34      Category = 'Project'
    3135      Caption = 'Open...'
    3236      OnExecute = AProjectOpenExecute
    … …  
    3438    end
    3539    object AProjectClose: TAction
     40      Category = 'Project'
    3641      Caption = 'Close'
    3742      OnExecute = AProjectCloseExecute
    … …  
    5358    end
    5459    object AProjectCheckout: TAction
     60      Category = 'Project'
    5561      Caption = 'Checkout...'
    5662      OnExecute = AProjectCheckoutExecute
    5763    end
     64    object AViewTest: TAction
     65      Caption = 'Test'
     66      OnExecute = AViewTestExecute
     67      ShortCut = 16468
     68    end
     69    object AProjectGroupNew: TAction
     70      Category = 'ProjectGroup'
     71      Caption = 'New'
     72      OnExecute = AProjectGroupNewExecute
     73    end
     74    object AProjectGroupOpen: TAction
     75      Category = 'ProjectGroup'
     76      Caption = 'Open...'
     77      OnExecute = AProjectGroupOpenExecute
     78    end
     79    object AProjectGroupClose: TAction
     80      Category = 'ProjectGroup'
     81      Caption = 'Close'
     82      OnExecute = AProjectGroupCloseExecute
     83    end
     84    object AProjectGroupSave: TAction
     85      Category = 'ProjectGroup'
     86      Caption = 'Save'
     87      OnExecute = AProjectGroupSaveExecute
     88    end
     89    object AProjectGroupSaveAs: TAction
     90      Category = 'ProjectGroup'
     91      Caption = 'Save as...'
     92      OnExecute = AProjectGroupSaveAsExecute
     93    end
    5894  end
    5995  object ImageList1: TImageList
    60     left = 260
    61     top = 228
     96    Height = 32
     97    Width = 32
     98    left = 288
     99    top = 240
    62100  end
    63101  object OpenDialog1: TOpenDialog
    64     left = 260
     102    Filter = 'Project groups (.vcgrp))|*.vcgrp|All files (.*)|*.*'
     103    left = 288
    65104    top = 96
    66105  end
    … …  
    72111    top = 96
    73112  end
    74   object LastOpenedList1: TLastOpenedList
     113  object LastOpenedListProject: TLastOpenedList
    75114    MaxCount = 10
    76     OnChange = LastOpenedList1Change
     115    OnChange = LastOpenedListProjectChange
    77116    left = 96
    78117    top = 168
    … …  
    88127    top = 302
    89128  end
     129  object LastOpenedListProjectGroup: TLastOpenedList
     130    MaxCount = 10
     131    OnChange = LastOpenedListProjectGroupChange
     132    left = 464
     133    top = 224
     134  end
     135  object SaveDialog1: TSaveDialog
     136    DefaultExt = '.vcgrp'
     137    Filter = 'Project groups (.vcgrp))|*.vcgrp|All files (.*)|*.*'
     138    left = 288
     139    top = 24
     140  end
    90141end

  • trunk/UCore.pas

    r10 r13  
    1919    ACommandCommit: TAction;
    2020    ACommandStatus: TAction;
     21    AProjectGroupSaveAs: TAction;
     22    AProjectGroupSave: TAction;
     23    AProjectGroupClose: TAction;
     24    AProjectGroupOpen: TAction;
     25    AProjectGroupNew: TAction;
     26    AViewTest: TAction;
    2127    AProjectCheckout: TAction;
    2228    AProjectClose: TAction;
    … …  
    2834    AViewFavorites: TAction;
    2935    ImageList1: TImageList;
    30     LastOpenedList1: TLastOpenedList;
     36    LastOpenedListProject: TLastOpenedList;
    3137    LastOpenedListNewDir: TLastOpenedList;
     38    LastOpenedListProjectGroup: TLastOpenedList;
    3239    LastOpenedListRepoURL: TLastOpenedList;
    3340    OpenDialog1: TOpenDialog;
     41    SaveDialog1: TSaveDialog;
    3442    XMLConfig1: TXMLConfig;
    3543    procedure ACommandCheckoutExecute(Sender: TObject);
    … …  
    3947    procedure AProjectCheckoutExecute(Sender: TObject);
    4048    procedure AProjectCloseExecute(Sender: TObject);
     49    procedure AProjectGroupCloseExecute(Sender: TObject);
     50    procedure AProjectGroupNewExecute(Sender: TObject);
     51    procedure AProjectGroupOpenExecute(Sender: TObject);
     52    procedure AProjectGroupSaveAsExecute(Sender: TObject);
     53    procedure AProjectGroupSaveExecute(Sender: TObject);
    4154    procedure AProjectOpenExecute(Sender: TObject);
    4255    procedure AQuitExecute(Sender: TObject);
    4356    procedure ASettingsExecute(Sender: TObject);
     57    procedure AViewTestExecute(Sender: TObject);
    4458    procedure DataModuleCreate(Sender: TObject);
    4559    procedure DataModuleDestroy(Sender: TObject);
    46     procedure LastOpenedList1Change(Sender: TObject);
     60    procedure LastOpenedListProjectChange(Sender: TObject);
     61    procedure LastOpenedListProjectGroupChange(Sender: TObject);
    4762  private
    4863    procedure UpdateInterface;
    … …  
    5368    Backends: TObjectList; // TList<TBackend>
    5469    Project: TProject;
     70    ProjectGroup: TProjectGroup;
     71    UserName: string;
     72    Email: string;
    5573    procedure LoadConfig;
    5674    procedure SaveConfig;
    … …  
    5876    procedure Done;
    5977    procedure ProjectOpen(Directory: string);
     78    procedure ProjectGroupOpen(FileName: string);
    6079  end;
    6180
    … …  
    6988uses
    7089  UFormMain, UFormBrowse, UFormSettings, UFormCommit, UFormCheckout,
    71   USubversion, UBazaar, UCVS;
     90  USubversion, UBazaar, UCVS, UGit, UFormTest, UFormProjectGroup;
    7291
    7392{ TCore }
    … …  
    8099procedure TCore.ASettingsExecute(Sender: TObject);
    81100begin
    82   FormSettings.ShowModal;
     101  FormSettings.Load(XMLConfig1);
     102  if FormSettings.ShowModal = mrOk then begin
     103    FormSettings.Save(XMLConfig1);
     104  end;
     105end;
     106
     107procedure TCore.AViewTestExecute(Sender: TObject);
     108begin
     109  FormTest.Show;
    83110end;
    84111
    … …  
    95122end;
    96123
    97 procedure TCore.LastOpenedList1Change(Sender: TObject);
    98 begin
    99   LastOpenedList1.LoadToMenuItem(FormMain.MenuItemOpenRecent, FormMain.OpenRecentExecute);
     124procedure TCore.LastOpenedListProjectChange(Sender: TObject);
     125begin
     126  LastOpenedListProject.LoadToMenuItem(FormMain.MenuItemOpenRecent, FormMain.OpenRecentExecute);
     127end;
     128
     129procedure TCore.LastOpenedListProjectGroupChange(Sender: TObject);
     130begin
     131  LastOpenedListProjectGroup.LoadToMenuItem(FormMain.MenuItemRecentProjectGroup, FormMain.ProjectGroupOpenRecentExecute);
    100132end;
    101133
    … …  
    103135begin
    104136  AProjectClose.Enabled := Assigned(Project);
     137  AProjectGroupClose.Enabled := Assigned(ProjectGroup);
     138  AProjectGroupSave.Enabled := Assigned(ProjectGroup);
     139  AProjectGroupSaveAs.Enabled := Assigned(ProjectGroup);
    105140  FormMain.UpdateInterface;
    106141end;
    … …  
    111146  RegisterBackend(TBackendBazaar.Create);
    112147  RegisterBackend(TBackendCVS.Create);
     148  RegisterBackend(TBackendGit.Create);
    113149end;
    114150
    … …  
    130166procedure TCore.LoadConfig;
    131167begin
    132   LastOpenedList1.LoadFromXMLConfig(XMLConfig1, 'LastOpenedProjects');
     168  LastOpenedListProject.LoadFromXMLConfig(XMLConfig1, 'LastOpenedProjects');
    133169  LastOpenedListRepoURL.LoadFromXMLConfig(XMLConfig1, 'LastOpenedRepoURL');
    134170  LastOpenedListNewDir.LoadFromXMLConfig(XMLConfig1, 'LastOpenedNewDir');
     171  LastOpenedListProjectGroup.LoadFromXMLConfig(XMLConfig1, 'LastOpenedListProjectGroup');
     172  UserName := XMLConfig1.GetValue('UserName', '');
     173  Email := XMLConfig1.GetValue('Email', '');
    135174end;
    136175
    137176procedure TCore.SaveConfig;
    138177begin
    139   LastOpenedList1.SaveToXMLConfig(XMLConfig1, 'LastOpenedProjects');
     178  LastOpenedListProject.SaveToXMLConfig(XMLConfig1, 'LastOpenedProjects');
    140179  LastOpenedListRepoURL.SaveToXMLConfig(XMLConfig1, 'LastOpenedRepoURL');
    141180  LastOpenedListNewDir.SaveToXMLConfig(XMLConfig1, 'LastOpenedNewDir');
     181  LastOpenedListProjectGroup.SaveToXMLConfig(XMLConfig1, 'LastOpenedListProjectGroup');
     182  XMLConfig1.SetValue('UserName', UserName);
     183  XMLConfig1.SetValue('Email', Email);
    142184end;
    143185
    … …  
    146188  RegisterBackends;
    147189  LoadConfig;
    148   if (LastOpenedList1.Items.Count > 0) and DirectoryExistsUTF8(LastOpenedList1.Items[0]) then
    149     ProjectOpen(LastOpenedList1.Items[0]);
     190  if (LastOpenedListProject.Items.Count > 0) and DirectoryExistsUTF8(LastOpenedListProject.Items[0]) then
     191    ProjectOpen(LastOpenedListProject.Items[0]);
    150192end;
    151193
    … …  
    160202  Project := TProject.Create;
    161203  Project.Backend := DetectBackend(Directory);
     204  Project.WorkingCopy.UserName := Core.UserName;
     205  Project.WorkingCopy.Email := Core.Email;
    162206  if Assigned(Project.Backend) then begin
    163207    Project.Directory := Directory;
    … …  
    165209    FormBrowse.Directory := Project.Directory;
    166210    FormBrowse.ReloadList;
    167     LastOpenedList1.AddItem(Project.Directory);
     211    LastOpenedListProject.AddItem(Project.Directory);
    168212  end else ShowMessage('Directory not recognized as working copy of any of supported VCS systems');
     213end;
     214
     215procedure TCore.ProjectGroupOpen(FileName: string);
     216begin
     217  AProjectGroupClose.Execute;
     218  ProjectGroup := TProjectGroup.Create;
     219  ProjectGroup.FileName := FileName;
     220  UpdateInterface;
     221  FormProjectGroup.ReloadTree;
     222  LastOpenedListProjectGroup.AddItem(FileName);
    169223end;
    170224
    … …  
    187241  FormBrowse.ReloadList;
    188242  UpdateInterface;
     243end;
     244
     245procedure TCore.AProjectGroupCloseExecute(Sender: TObject);
     246begin
     247  FreeAndNil(ProjectGroup);
     248  UpdateInterface;
     249  FormProjectGroup.ReloadTree;
     250end;
     251
     252procedure TCore.AProjectGroupNewExecute(Sender: TObject);
     253begin
     254  AProjectClose.Execute;
     255  ProjectGroup := TProjectGroup.Create;
     256  ProjectGroup.FileName := 'New project group.vcgrp';
     257  UpdateInterface;
     258  FormProjectGroup.ReloadTree;
     259end;
     260
     261procedure TCore.AProjectGroupOpenExecute(Sender: TObject);
     262begin
     263  if LastOpenedListProjectGroup.Items.Count > 0 then
     264    OpenDialog1.FileName := LastOpenedListProjectGroup.Items[0];
     265  if OpenDialog1.Execute then begin
     266    AProjectClose.Execute;
     267    ProjectGroupOpen(OpenDialog1.FileName);
     268  end;
     269end;
     270
     271procedure TCore.AProjectGroupSaveAsExecute(Sender: TObject);
     272begin
     273  SaveDialog1.FileName := ProjectGroup.FileName;
     274  if SaveDialog1.Execute then begin
     275    ProjectGroup.SaveToFile(SaveDialog1.FileName);
     276    UpdateInterface;
     277  end;
     278end;
     279
     280procedure TCore.AProjectGroupSaveExecute(Sender: TObject);
     281begin
     282  if FileExistsUTF8(ProjectGroup.FileName) then ProjectGroup.SaveToFile(ProjectGroup.FileName)
     283    else AProjectGroupSaveAs.Execute;
    189284end;
    190285

  • trunk/Units/UBackend.pas

    r10 r13  
    1010type
    1111  TWorkingCopyClass = class of TWorkingCopy;
     12  TRepositoryClass = class of TRepository;
    1213
    1314  { TBackend }
    … …  
    1516  TBackend = class
    1617    Name: string;
     18    HomePage: string;
    1719    WorkingCopyClass: TWorkingCopyClass;
     20    RepositoryClass: TRepositoryClass;
     21    function IsRepository(Directory: string): Boolean; virtual;
    1822    function IsWorkingCopy(Directory: string): Boolean; virtual;
    1923  end;
    … …  
    2226
    2327{ TBackend }
     28
     29function TBackend.IsRepository(Directory: string): Boolean;
     30begin
     31  Result := False;
     32end;
    2433
    2534function TBackend.IsWorkingCopy(Directory: string): Boolean;

  • trunk/Units/UProject.pas

    r9 r13  
    66
    77uses
    8   Classes, SysUtils, UVCS, UBackend;
     8  Classes, SysUtils, UVCS, UBackend, Contnrs, DOM, XMLRead, XMLWrite, UXMLUtils,
     9  FileUtil;
    910
    1011type
    … …  
    2223  public
    2324    WorkingCopy: TWorkingCopy;
     25    Repository: TRepository;
    2426    procedure Open(Directory: string);
    2527    constructor Create;
    2628    destructor Destroy; override;
     29    procedure LoadXMLNOde(Node: TDOMNode);
     30    procedure SaveXMLNOde(Node: TDOMNode);
    2731    property Backend: TBackend read FBackend write SetBackend;
    2832    property Directory: string read GetDirectory write SetDirectory;
    … …  
    3034  end;
    3135
     36  { TProjects }
     37
     38  TProjects = class(TObjectList)
     39    procedure LoadXMLNode(Node: TDOMNode);
     40    procedure SaveXMLNode(Node: TDOMNode);
     41  end;
     42
     43  { TProjectGroup }
     44
     45  TProjectGroup = class
     46    FileName: string;
     47    Projects: TProjects;
     48    constructor Create;
     49    destructor Destroy; override;
     50    procedure LoadFromFile(FileName: string);
     51    procedure SaveToFile(FileName: string);
     52  end;
     53
    3254
    3355implementation
    3456
    35 uses
    36   USubversion;
     57resourcestring
     58  SWrongFileFormat = 'Wrong file format';
     59
     60{ TProjects }
     61
     62procedure TProjects.LoadXMLNode(Node: TDOMNode);
     63var
     64  NewProject: TProject;
     65  Node2: TDOMNode;
     66begin
     67  Node2 := Node.FirstChild;
     68  while Assigned(Node2) and (Node2.NodeName = 'Project') do begin
     69    NewProject := TProject.Create;
     70    NewProject.LoadXMLNode(Node2);
     71    Add(NewProject);
     72    Node2 := Node2.NextSibling;
     73  end;
     74end;
     75
     76procedure TProjects.SaveXMLNode(Node: TDOMNode);
     77var
     78  I: Integer;
     79  NewNode: TDOMNode;
     80begin
     81  for I := 0 to Count - 1 do begin;
     82    NewNode := Node.OwnerDocument.CreateElement('Project');
     83    Node.AppendChild(NewNode);
     84    TProject(Items[I]).SaveXMLNode(NewNode);
     85  end;
     86end;
     87
     88
     89{ TProjectGroup }
     90
     91constructor TProjectGroup.Create;
     92begin
     93  Projects := TProjects.Create;
     94end;
     95
     96destructor TProjectGroup.Destroy;
     97begin
     98  Projects.Free;
     99  inherited Destroy;
     100end;
     101
     102procedure TProjectGroup.LoadFromFile(FileName: string);
     103var
     104  Doc: TXMLDocument;
     105  RootNode: TDOMNode;
     106  Node: TDOMNode;
     107  Node2: TDOMNode;
     108begin
     109  Self.FileName := FileName;
     110  ReadXMLFile(Doc, UTF8Decode(FileName));
     111  with Doc do try
     112    if Doc.DocumentElement.NodeName <> 'ProjectGroup' then
     113      raise Exception.Create(SWrongFileFormat);
     114    RootNode := Doc.DocumentElement;
     115    with RootNode do begin
     116      Node := FindNode('Projects');
     117      if Assigned(Node) then Projects.LoadXMLNode(Node);
     118    end;
     119  finally
     120    Doc.Free;
     121  end;
     122end;
     123
     124procedure TProjectGroup.SaveToFile(FileName: string);
     125var
     126  NewNode: TDOMNode;
     127  Doc: TXMLDocument;
     128  RootNode: TDOMNode;
     129begin
     130  if FileName = '' then Exit;
     131  Self.FileName := FileName;
     132  Doc := TXMLDocument.Create;
     133  with Doc do try
     134    RootNode := CreateElement('ProjectGroup');
     135    AppendChild(RootNode);
     136    with RootNode do begin
     137      NewNode := OwnerDocument.CreateElement('Projects');
     138      AppendChild(NewNode);
     139      Projects.SaveXMLNode(NewNode);
     140    end;
     141    ForceDirectoriesUTF8(ExtractFileDir(FileName));
     142    WriteXMLFile(Doc, UTF8Decode(FileName));
     143  finally
     144    Doc.Free;
     145  end;
     146end;
    37147
    38148{ TProject }
    … …  
    44154  FreeAndNil(WorkingCopy);
    45155  WorkingCopy := AValue.WorkingCopyClass.Create;
     156  FreeAndNil(Repository);
     157  Repository := AValue.RepositoryClass.Create;
    46158end;
    47159
    … …  
    64176begin
    65177  WorkingCopy.RepositoryURL := AValue;
     178  Repository.Path := AValue;
    66179end;
    67180
    … …  
    74187begin
    75188  WorkingCopy := TWorkingCopy.Create;
     189  Repository := TRepository.Create;
    76190end;
    77191
    … …  
    79193begin
    80194  WorkingCopy.Free;
     195  Repository.Free;
    81196  inherited Destroy;
    82197end;
    83198
     199procedure TProject.LoadXMLNOde(Node: TDOMNode);
     200begin
     201  RepositoryURL := ReadString(Node, 'RepositoryURL', '');
     202  Directory := ReadString(Node, 'Directory', '');
     203end;
     204
     205procedure TProject.SaveXMLNOde(Node: TDOMNode);
     206begin
     207  WriteString(Node, 'RepositoryURL', RepositoryURL);
     208  WriteString(Node, 'Directory', Directory);
     209end;
     210
    84211end.
    85212

  • trunk/Units/UVCS.pas

    r11 r13  
    3636    procedure SetRepositoryURL(AValue: string);
    3737  protected
     38    EnvVars: TStringList;
    3839    procedure ExecuteProcess(Command: string; Parameters: array of string); virtual;
    3940    function GetNext(var Text: string; Separator: string): string;
    4041  public
     42    UserName: string;
     43    Password: string;
     44    Email: string;
    4145    ExecutionOutput: TStringList;
    4246    procedure Checkout; virtual;
    … …  
    4852    procedure Refresh; virtual;
    4953    procedure Add(FileName: string); virtual;
     54    procedure Remove(FileName: string); virtual;
    5055    procedure GetLog(FileName: string; Log: TLogList); virtual;
    5156    constructor Create;
    … …  
    5560  end;
    5661
     62  { TRepository }
     63
    5764  TRepository = class
     65  protected
     66    procedure ExecuteProcess(Command: string; Parameters: array of string); virtual;
     67  public
     68    ExecutionOutput: TStringList;
    5869    Path: string;
    59   end;
    60 
    61 
     70    procedure Init; virtual;
     71    constructor Create;
     72    destructor Destroy; override;
     73  end;
     74
     75
     76function URLFromDirectory(DirName: string; Relative: Boolean): string;
    6277
    6378implementation
    … …  
    6681  UFormConsole;
    6782
    68 { TLogItem }
    69 
    70 constructor TLogItem.Create;
    71 begin
    72   Messages := TStringList.Create;
    73   ChangedFiles := TStringList.Create;
    74 end;
    75 
    76 destructor TLogItem.Destroy;
    77 begin
    78   Messages.Free;
    79   ChangedFiles.Free;
    80   inherited Destroy;
    81 end;
    82 
    83 { TWorkingCopy }
    84 
    85 procedure TWorkingCopy.SetPath(AValue: string);
    86 begin
    87   if FPath = AValue then Exit;
    88   FPath := AValue;
    89   Refresh;
    90 end;
    91 
    92 procedure TWorkingCopy.SetRepositoryURL(AValue: string);
    93 begin
    94   if FRepositoryURL=AValue then Exit;
    95   FRepositoryURL:=AValue;
    96 end;
    97 
    98 procedure TWorkingCopy.ExecuteProcess(Command: string; Parameters: array of string);
     83function URLFromDirectory(DirName: string; Relative: Boolean): string;
     84begin
     85  Result := DirName;
     86  if Relative then Result := GetCurrentDirUTF8 + DirectorySeparator + Result;
     87  Result := 'file:///' + StringReplace(Result, DirectorySeparator, '/', [rfReplaceAll]);
     88end;
     89
     90{ TRepository }
     91
     92procedure TRepository.ExecuteProcess(Command: string;
     93  Parameters: array of string);
    9994begin
    10095  FormConsole.Executable := Command;
    … …  
    107102end;
    108103
     104procedure TRepository.Init;
     105begin
     106
     107end;
     108
     109constructor TRepository.Create;
     110begin
     111  ExecutionOutput := TStringList.Create;
     112  Path := '';
     113end;
     114
     115destructor TRepository.Destroy;
     116begin
     117  FreeAndNil(ExecutionOutput);
     118  inherited Destroy;
     119end;
     120
     121{ TLogItem }
     122
     123constructor TLogItem.Create;
     124begin
     125  Messages := TStringList.Create;
     126  ChangedFiles := TStringList.Create;
     127end;
     128
     129destructor TLogItem.Destroy;
     130begin
     131  Messages.Free;
     132  ChangedFiles.Free;
     133  inherited Destroy;
     134end;
     135
     136{ TWorkingCopy }
     137
     138procedure TWorkingCopy.SetPath(AValue: string);
     139begin
     140  if FPath = AValue then Exit;
     141  FPath := AValue;
     142  Refresh;
     143end;
     144
     145procedure TWorkingCopy.SetRepositoryURL(AValue: string);
     146begin
     147  if FRepositoryURL=AValue then Exit;
     148  FRepositoryURL:=AValue;
     149end;
     150
     151procedure TWorkingCopy.ExecuteProcess(Command: string; Parameters: array of string);
     152begin
     153  FormConsole.Executable := Command;
     154  FormConsole.EnvironmentVariables.Assign(EnvVars);
     155  FormConsole.Parameters.Clear;
     156  FormConsole.Parameters.AddStrings(Parameters);
     157  if DirectoryExistsUTF8(Path) then FormConsole.WorkingDir := Path
     158    else FormConsole.WorkingDir := '';
     159  FormConsole.ShowModal;
     160  ExecutionOutput.Assign(FormConsole.Log);
     161end;
     162
    109163function TWorkingCopy.GetNext(var Text: string; Separator: string): string;
    110164begin
    … …  
    158212end;
    159213
     214procedure TWorkingCopy.Remove(FileName: string);
     215begin
     216
     217end;
     218
    160219procedure TWorkingCopy.GetLog(FileName: string; Log: TLogList);
    161220begin
    … …  
    166225begin
    167226  ExecutionOutput := TStringList.Create;
     227  EnvVars := TStringList.Create;
    168228  FPath := '';
    169229  FRepositoryURL := '';
    … …  
    172232destructor TWorkingCopy.Destroy;
    173233begin
     234  FreeAndNil(EnvVars);
    174235  FreeAndNil(ExecutionOutput);
    175236  inherited Destroy;

  • trunk/VCSCommander.lpi

    r11 r13  
    2727          <SearchPaths>
    2828            <IncludeFiles Value="$(ProjOutDir)"/>
    29             <OtherUnitFiles Value="Backends/CVS"/>
     29            <OtherUnitFiles Value="Backends/CVS;Backends/Git"/>
    3030            <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
    3131          </SearchPaths>
    … …  
    8484      </Item4>
    8585    </RequiredPackages>
    86     <Units Count="16">
     86    <Units Count="19">
    8787      <Unit0>
    8888        <Filename Value="VCSCommander.lpr"/>
    … …  
    176176        <ResourceBaseClass Value="Form"/>
    177177      </Unit15>
     178      <Unit16>
     179        <Filename Value="Backends/Git/UGit.pas"/>
     180        <IsPartOfProject Value="True"/>
     181      </Unit16>
     182      <Unit17>
     183        <Filename Value="Forms/UFormTest.pas"/>
     184        <IsPartOfProject Value="True"/>
     185        <ComponentName Value="FormTest"/>
     186        <ResourceBaseClass Value="Form"/>
     187      </Unit17>
     188      <Unit18>
     189        <Filename Value="Forms/UFormProjectGroup.pas"/>
     190        <IsPartOfProject Value="True"/>
     191        <ComponentName Value="FormProjectGroup"/>
     192        <ResourceBaseClass Value="Form"/>
     193      </Unit18>
    178194    </Units>
    179195  </ProjectOptions>
    … …  
    185201    <SearchPaths>
    186202      <IncludeFiles Value="$(ProjOutDir)"/>
    187       <OtherUnitFiles Value="Forms;Units;Backends/Bazaar;Backends/Subversion;Backends/CVS"/>
     203      <OtherUnitFiles Value="Forms;Units;Backends/Bazaar;Backends/Subversion;Backends/CVS;Backends/Git"/>
    188204      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
    189205    </SearchPaths>
    … …  
    204220        <StackChecks Value="True"/>
    205221      </Checks>
    206       <VerifyObjMethodCallValidity Value="True"/>
    207222    </CodeGeneration>
    208223    <Linking>

  • trunk/VCSCommander.lpr

    r11 r13  
    1010  Forms, UFormMain, UCore, Common, TemplateGenerics, UFormBrowse, UVCS,
    1111  UFormFavorites, UFormSettings, UFormConsole, USubversion, UProject, SysUtils,
    12   UFormCommit, UFormCheckout, UBazaar, UBackend, UFormLog
     12  UFormCommit, UFormCheckout, UBazaar, UBackend, UFormLog, UFormTest,
     13  UFormProjectGroup
    1314  { you can add units after this };
    1415
    … …  
    3940  Application.CreateForm(TFormCheckout, FormCheckout);
    4041  Application.CreateForm(TFormLog, FormLog);
     42  Application.CreateForm(TFormTest, FormTest);
     43  Application.CreateForm(TFormProjectGroup, FormProjectGroup);
    4144  Application.Run;
    4245end.
Note: See TracChangeset for help on using the changeset viewer.