Changeset 15


Ignore:
Timestamp:
Jul 13, 2015, 11:44:23 AM (9 years ago)
Author:
chronos
Message:
  • Added: Support for reading file status from working copy.
Location:
trunk
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • trunk/Backends/CVS/UCVS.pas

    r13 r15  
    3232    procedure Add(FileName: string); override;
    3333    procedure Remove(FileName: string); override;
     34    procedure GetStatus(FileName: string; Status: TFileStatusList); override;
    3435  end;
    3536
    … …  
    125126end;
    126127
     128procedure TCVS.GetStatus(FileName: string; Status: TFileStatusList);
     129begin
     130  Status.Clear;
     131  Execute(['status']);
     132
     133end;
     134
    127135end.
    128136

  • trunk/Backends/Subversion/USubversion.pas

    r14 r15  
    66
    77uses
    8   Classes, SysUtils, UVCS, UBackend;
     8  Classes, SysUtils, UVCS, UBackend, XMLRead, DOM, UXMLUtils;
    99
    1010type
    … …  
    3333    procedure Remove(FileName: string); override;
    3434    procedure GetLog(FileName: string; Log: TLogList); override;
     35    procedure GetStatus(FileName: string; Status: TFileStatusList); override;
    3536  end;
    3637
    … …  
    172173end;
    173174
     175procedure TSubversion.GetStatus(FileName: string; Status: TFileStatusList);
     176var
     177  Doc: TXMLDocument;
     178  S: TStringStream;
     179  Node: TDOMNode;
     180  Node2: TDOMNode;
     181  RootNode: TDOMNode;
     182  TargetNode: TDOMNode;
     183  StatusNode: TDOMNode;
     184  StatusItem: TFileStatus;
     185  CommitNode: TDOMNode;
     186  ItemState: string;
     187begin
     188  Status.Clear;
     189  Execute(['status', '--xml', '-v']);
     190  S := TStringStream.Create(ExecutionOutput.Text);
     191  try
     192    // Read complete XML document
     193    ReadXMLFile(Doc, S);
     194    RootNode := Doc.DocumentElement;
     195    if RootNode.NodeName = 'status' then begin
     196      TargetNode := RootNode.FindNode('target');
     197      if Assigned(TargetNode) then begin
     198        Node := TargetNode.FirstChild;
     199        while Assigned(Node) do begin
     200          if Node.NodeName = 'entry' then begin
     201            StatusItem := TFileStatus.Create;
     202            StatusItem.FileName := TDOMElement(Node).GetAttribute('path');
     203            StatusNode := Node.FindNode('wc-status');
     204            if Assigned(StatusNode) then begin
     205              ItemState := TDOMElement(StatusNode).GetAttribute('item');
     206              if ItemState = 'normal' then StatusItem.State := fssNotModified;
     207              if ItemState = 'modified' then StatusItem.State := fssModified;
     208              if ItemState = 'deleted' then StatusItem.State := fssRemoved;
     209              if ItemState = 'added' then StatusItem.State := fssAdded;
     210
     211              CommitNode := StatusNode.FindNode('commit');
     212              if Assigned(CommitNode) then begin
     213                 StatusItem.Version := TDOMElement(CommitNode).GetAttribute('revision');
     214                 StatusItem.Author := ReadString(CommitNode, 'author', '');
     215                 StatusItem.Time := ReadDateTime(CommitNode, 'date', 0);
     216              end;
     217            end;
     218            Status.Add(StatusItem);
     219          end;
     220          Node := Node.NextSibling;
     221        end;
     222      end;
     223    end;
     224  finally
     225    Doc.Free;
     226    S.Free;
     227  end;
     228end;
     229
    174230end.
    175231

  • trunk/Forms/UFormBrowse.lfm

    r13 r15  
    11object FormBrowse: TFormBrowse
    2   Left = 952
    3   Height = 526
    4   Top = 287
    5   Width = 722
     2  Left = 479
     3  Height = 538
     4  Top = 279
     5  Width = 964
    66  Caption = 'Browse'
    7   ClientHeight = 526
    8   ClientWidth = 722
     7  ClientHeight = 538
     8  ClientWidth = 964
     9  Menu = MainMenu1
    910  OnCreate = FormCreate
    1011  OnDestroy = FormDestroy
    … …  
    1314  object TreeView1: TTreeView
    1415    Left = 0
    15     Height = 526
     16    Height = 538
    1617    Top = 0
    1718    Width = 241
    1819    Align = alLeft
    19     DefaultItemHeight = 28
     20    DefaultItemHeight = 24
    2021    TabOrder = 0
    2122  end
    2223  object Splitter1: TSplitter
    2324    Left = 241
    24     Height = 526
     25    Height = 538
    2526    Top = 0
    2627    Width = 5
    … …  
    2829  object ListView1: TListView
    2930    Left = 246
    30     Height = 526
     31    Height = 538
    3132    Top = 0
    32     Width = 476
     33    Width = 718
    3334    Align = alClient
    3435    Columns = <   
    … …  
    121122    end
    122123  end
     124  object MainMenu1: TMainMenu
     125    left = 429
     126    top = 516
     127  end
    123128end

  • trunk/Forms/UFormBrowse.pas

    r11 r15  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
    9   ExtCtrls, Menus, ActnList, UFindFile, UVCS;
     9  ExtCtrls, Menus, ActnList, UFindFile, UVCS, Contnrs;
    1010
    1111type
    … …  
    2323    ActionList1: TActionList;
    2424    ListView1: TListView;
     25    MainMenu1: TMainMenu;
    2526    MenuItem1: TMenuItem;
    2627    MenuItem2: TMenuItem;
    … …  
    4647      Selected: Boolean);
    4748  private
    48     FileList: TStringList;
     49    FileList: TObjectList;
    4950  public
    5051    Directory: string;
    … …  
    6768procedure TFormBrowse.ListView1Data(Sender: TObject; Item: TListItem);
    6869begin
    69   if (Item.Index >= 0) and (Item.Index < FileList.Count) then begin
    70     Item.Caption := ExtractFileName(FileList[Item.Index]);
     70  if (Item.Index >= 0) and (Item.Index < FileList.Count) then
     71  with TFileStatus(FileList[Item.Index]) do begin
     72    Item.Caption := ExtractFileName(FileName);
     73    if State <> fssNonVersioned then begin
     74      Item.SubItems.Add(Version);
     75      Item.SubItems.Add(DateToStr(Time));
     76      Item.SubItems.Add(Author);
     77      Item.SubItems.Add(FileStatusStateText[State]);
     78    end;
    7179  end;
    7280end;
    … …  
    124132procedure TFormBrowse.FormCreate(Sender: TObject);
    125133begin
    126   FileList := TStringList.Create;
     134  FileList := TObjectList.Create;
    127135end;
    128136
    … …  
    142150  FoundFileList: TStrings;
    143151  I: Integer;
    144 begin
     152  FileStatusList: TFileStatusList;
     153  NewFileItem: TFileStatus;
     154  FS: TFileStatus;
     155  RelativeName: string;
     156begin
     157  FileList.Clear;
     158  if Assigned(Core.Project) then begin
     159  FileStatusList := TFileStatusList.Create;
     160  try
     161  Core.Project.WorkingCopy.GetStatus(Directory, FileStatusList);
     162
    145163  if DirectoryExistsUTF8(Directory) then begin
    146164    FindFile := TFindFile.Create(nil);
    … …  
    150168      FindFile.InSubFolders := False;
    151169      FoundFileList := FindFile.SearchForFiles;
    152       FileList.Assign(FoundFileList);
     170      //FoundFileList.Sort;
     171      for I := 0 to FoundFileList.Count - 1 do begin
     172        NewFileItem := TFileStatus.Create;
     173        NewFileItem.FileName := FoundFileList[I];
     174        RelativeName := NewFileItem.FileName;
     175        if Copy(RelativeName, 1, Length(Core.Project.WorkingCopy.Path)) = Core.Project.WorkingCopy.Path then
     176          Delete(RelativeName, 1, Length(Core.Project.WorkingCopy.Path));
     177        if Copy(RelativeName, 1, 1) = DirectorySeparator then
     178          Delete(RelativeName, 1, Length(DirectorySeparator));
     179        FS := FileStatusList.SearchByName(RelativeName);
     180        if Assigned(FS) then begin
     181          NewFileItem.Assign(FS);
     182        end;
     183        FileList.Add(NewFileItem);
     184      end;
    153185      for I := FileList.Count - 1 downto 0 do
    154         if ExtractFileName(FileList[I]) = '.' then FileList.Delete(I);
    155       FileList.Sort;
     186        if ExtractFileName(TFileStatus(FileList[I]).FileName) = '.' then FileList.Delete(I);
    156187      ListView1.Items.Count := FileList.Count;
    157188    finally
    … …  
    159190    end;
    160191  end else ListView1.Items.Count := 0;
     192  finally
     193    FileStatusList.Free;
     194  end;
     195  end;
    161196  ListView1.Refresh;
    162197end;

  • trunk/Packages/Common/UXMLUtils.pas

    r6 r15  
    1414procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean);
    1515procedure WriteString(Node: TDOMNode; Name: string; Value: string);
     16procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime);
    1617function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer;
    1718function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean;
    1819function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string;
     20function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime): TDateTime;
    1921
    2022
    … …  
    7274  Minute: Integer;
    7375  Second: Integer;
     76  SecondFraction: Double;
    7477  Millisecond: Integer;
    7578begin
    … …  
    9497      if Pos('Z', XMLDateTime) > 0 then
    9598        LeftCutString(XMLDateTime, Part, 'Z');
    96       Millisecond := StrToInt(Part);
     99      SecondFraction := StrToFloat('0.' + Part);
     100      Millisecond := Trunc(SecondFraction * 1000);
    97101    end else begin
    98102      if Pos('+', XMLDateTime) > 0 then
    … …  
    156160end;
    157161
     162procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime);
     163var
     164  NewNode: TDOMNode;
     165begin
     166  NewNode := Node.OwnerDocument.CreateElement(Name);
     167  NewNode.TextContent := DateTimeToXMLTime(Value);
     168  Node.AppendChild(NewNode);
     169end;
     170
    158171function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer;
    159172var
    … …  
    186199end;
    187200
     201function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime
     202  ): TDateTime;
     203var
     204  NewNode: TDOMNode;
     205begin
     206  Result := DefaultValue;
     207  NewNode := Node.FindNode(Name);
     208  if Assigned(NewNode) then
     209    Result := XMLTimeToDateTime(NewNode.TextContent);
     210end;
     211
    188212end.
    189213

  • trunk/UCore.pas

    r14 r15  
    209209    FormBrowse.ReloadList;
    210210    LastOpenedListProject.AddItem(Project.Directory);
    211   end else ShowMessage('Directory not recognized as working copy of any of supported VCS systems');
     211  end else ShowMessage('Directory ''' + Directory + ''' not recognized as working copy of any of supported VCS systems');
    212212end;
    213213

  • trunk/Units/UVCS.pas

    r13 r15  
    2525  TLogList = class(TObjectList)
    2626
     27  end;
     28
     29  TFileStatusState = (fssNonVersioned, fssAdded, fssRemoved, fssModified, fssNotModified);
     30
     31  { TFileStatus }
     32
     33  TFileStatus = class
     34    FileName: string;
     35    Version: string;
     36    Author: string;
     37    Time: TDateTime;
     38    State: TFileStatusState;
     39    procedure Assign(Source: TFileStatus);
     40  end;
     41
     42  { TFileStatusList }
     43
     44  TFileStatusList = class(TObjectList)
     45    function SearchByName(Name: string): TFileStatus;
    2746  end;
    2847
    … …  
    5473    procedure Remove(FileName: string); virtual;
    5574    procedure GetLog(FileName: string; Log: TLogList); virtual;
     75    procedure GetStatus(FileName: string; Status: TFileStatusList); virtual;
    5676    constructor Create;
    5777    destructor Destroy; override;
    … …  
    7696function URLFromDirectory(DirName: string; Relative: Boolean): string;
    7797
     98const
     99  FileStatusStateText: array[TFileStatusState] of string = ('Not versioned',
     100    'Added', 'Removed', 'Modified', 'Normal');
     101
    78102implementation
    79103
    … …  
    86110  if Relative then Result := GetCurrentDirUTF8 + DirectorySeparator + Result;
    87111  Result := 'file:///' + StringReplace(Result, DirectorySeparator, '/', [rfReplaceAll]);
     112end;
     113
     114{ TFileStatus }
     115
     116procedure TFileStatus.Assign(Source: TFileStatus);
     117begin
     118  FileName := Source.FileName;
     119  Version := Source.Version;
     120  Time := Source.Time;
     121  Author := Source.Author;
     122  State := Source.State;
     123end;
     124
     125{ TFileStatusList }
     126
     127function TFileStatusList.SearchByName(Name: string): TFileStatus;
     128var
     129  I: Integer;
     130begin
     131  I := 0;
     132  while (I < Count) and (TFileStatus(Items[I]).FileName <> Name) do Inc(I);
     133  if I < Count then Result := TFileStatus(Items[I])
     134    else Result := nil;
    88135end;
    89136
    … …  
    222269end;
    223270
     271procedure TWorkingCopy.GetStatus(FileName: string; Status: TFileStatusList);
     272begin
     273  Status.Clear;
     274end;
     275
    224276constructor TWorkingCopy.Create;
    225277begin

  • trunk/VCSCommander.lpi

    r14 r15  
    111111        <HasResources Value="True"/>
    112112        <ResourceBaseClass Value="Form"/>
     113        <UnitName Value="UFormBrowse"/>
    113114      </Unit3>
    114115      <Unit4>
    115116        <Filename Value="Units/UVCS.pas"/>
    116117        <IsPartOfProject Value="True"/>
     118        <UnitName Value="UVCS"/>
    117119      </Unit4>
    118120      <Unit5>
    … …  
    122124        <HasResources Value="True"/>
    123125        <ResourceBaseClass Value="Form"/>
     126        <UnitName Value="UFormFavorites"/>
    124127      </Unit5>
    125128      <Unit6>
    … …  
    129132        <HasResources Value="True"/>
    130133        <ResourceBaseClass Value="Form"/>
     134        <UnitName Value="UFormSettings"/>
    131135      </Unit6>
    132136      <Unit7>
    … …  
    138142        <Filename Value="Units/UProject.pas"/>
    139143        <IsPartOfProject Value="True"/>
     144        <UnitName Value="UProject"/>
    140145      </Unit8>
    141146      <Unit9>
    … …  
    160165        <HasResources Value="True"/>
    161166        <ResourceBaseClass Value="Form"/>
     167        <UnitName Value="UFormCheckout"/>
    162168      </Unit11>
    163169      <Unit12>
    … …  
    172178        <Filename Value="Backends/CVS/UCVS.pas"/>
    173179        <IsPartOfProject Value="True"/>
     180        <UnitName Value="UCVS"/>
    174181      </Unit14>
    175182      <Unit15>
Note: See TracChangeset for help on using the changeset viewer.