Check-in [bf6cd97dbd]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added bgcolor drop-down for commit. Started link between commit form and commit message frame. Corrected implementation of Branch, Info and Tags properties. Corrected ColorToHex. Added comments for future implementation of Fossil output events.
Timelines: family | ancestors | descendants | both | lazarus
Files: files | file ages | folders
SHA1:bf6cd97dbd1eb1b914a022fcd9f3fd080bc36903
User & Date: tinus 2014-08-05 20:18:36
Context
2014-08-06
06:10
Added new unit with start of syntax highlighter for wide diff. check-in: f26843ce0b user: tinus tags: lazarus
2014-08-05
20:18
Added bgcolor drop-down for commit. Started link between commit form and commit message frame. Corrected implementation of Branch, Info and Tags properties. Corrected ColorToHex. Added comments for future implementation of Fossil output events. check-in: bf6cd97dbd user: tinus tags: lazarus
16:11
Prepare commit command. check-in: 591b0707ba user: MCO tags: lazarus
Changes

Changes to src/a_commitmessage.lfm.

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56















57
58
59
60
61
62
63
64
65
66


67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
...
543
544
545
546
547
548
549

550
551
552
553
554
555
556
557
558
559
        AutoSize = True
        Caption = 'Branch'
        Style = tbsDropDown
      end
      object btnOptions: TToolButton
        AnchorSideRight.Control = tbrMessage
        AnchorSideRight.Side = asrBottom
        Left = 143
        Top = 0
        Caption = 'Options'
      end
      object btnSep1: TToolButton
        Left = 58
        Top = 0
        Width = 10
        Caption = ' '
        Style = tbsSeparator
      end
      object btnMessage: TToolButton
        Left = 68
        Top = 0
        Caption = 'Message...'
        Style = tbsDropDown















      end
    end
    object btnCommit: TButton
      Left = 335
      Height = 25
      Top = 1
      Width = 75
      Anchors = [akTop, akRight]
      Caption = 'Commit'
      Default = True


      TabOrder = 0
    end
  end
  object sbrMessage: TStatusBar
    Left = 0
    Height = 23
    Top = 217
    Width = 411
    Panels = <>
    SimplePanel = False
  end
  inline synMessage: TSynEdit
    Left = 0
    Height = 167
    Top = 50
    Width = 411
    Align = alClient
    Font.Height = 12
    Font.Name = 'Monaco'
    Font.Pitch = fpFixed
    Font.Quality = fqCleartype
................................................................................
    MouseLinkColor.Foreground = clBlue
    MouseLinkColor.FrameEdges = sfeAround
    LineHighlightColor.Background = clNone
    LineHighlightColor.Foreground = clNone
    LineHighlightColor.FrameEdges = sfeAround
    TabWidth = 4
    WantTabs = False

    inline SynLeftGutterPartList1: TSynGutterPartList
      object SynGutterLineNumber1: TSynGutterLineNumber
        Width = 11
        Visible = False
        MouseActions = <>
        MarkupInfo.Background = clBtnFace
        MarkupInfo.Foreground = clNone
        MarkupInfo.FrameEdges = sfeAround
        DigitCount = 2
        ShowOnlyLineNumbersMultiplesOf = 1







|




|






|



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>










>
>





|
|


<



|







 







>


|







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92

93
94
95
96
97
98
99
100
101
102
103
...
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
        AutoSize = True
        Caption = 'Branch'
        Style = tbsDropDown
      end
      object btnOptions: TToolButton
        AnchorSideRight.Control = tbrMessage
        AnchorSideRight.Side = asrBottom
        Left = 161
        Top = 0
        Caption = 'Options'
      end
      object btnSep1: TToolButton
        Left = 64
        Top = 0
        Width = 10
        Caption = ' '
        Style = tbsSeparator
      end
      object btnMessage: TToolButton
        Left = 74
        Top = 0
        Caption = 'Message...'
        Style = tbsDropDown
      end
      object cbxColor: TColorBox
        Left = 219
        Height = 20
        Top = 0
        Width = 109
        DefaultColorColor = clWindow
        Selected = clDefault
        Style = [cbStandardColors, cbExtendedColors, cbIncludeDefault, cbCustomColor, cbPrettyNames]
        AutoComplete = True
        AutoCompleteText = [cbactEnabled, cbactEndOfLineComplete, cbactSearchAscending]
        AutoDropDown = True
        DropDownCount = 16
        ItemHeight = 0
        TabOrder = 0
      end
    end
    object btnCommit: TButton
      Left = 335
      Height = 25
      Top = 1
      Width = 75
      Anchors = [akTop, akRight]
      Caption = 'Commit'
      Default = True
      Enabled = False
      OnClick = btnCommitClick
      TabOrder = 0
    end
  end
  object sbrMessage: TStatusBar
    Left = 0
    Height = 15
    Top = 225
    Width = 411
    Panels = <>

  end
  inline synMessage: TSynEdit
    Left = 0
    Height = 175
    Top = 50
    Width = 411
    Align = alClient
    Font.Height = 12
    Font.Name = 'Monaco'
    Font.Pitch = fpFixed
    Font.Quality = fqCleartype
................................................................................
    MouseLinkColor.Foreground = clBlue
    MouseLinkColor.FrameEdges = sfeAround
    LineHighlightColor.Background = clNone
    LineHighlightColor.Foreground = clNone
    LineHighlightColor.FrameEdges = sfeAround
    TabWidth = 4
    WantTabs = False
    OnChange = synMessageChange
    inline SynLeftGutterPartList1: TSynGutterPartList
      object SynGutterLineNumber1: TSynGutterLineNumber
        Width = 15
        Visible = False
        MouseActions = <>
        MarkupInfo.Background = clBtnFace
        MarkupInfo.Foreground = clNone
        MarkupInfo.FrameEdges = sfeAround
        DigitCount = 2
        ShowOnlyLineNumbersMultiplesOf = 1

Changes to src/a_commitmessage.pas.

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

18
19
20
21
22
23
24
25


26


27
28
29
30


31
32
33
34
35
36
37
..
47
48
49
50
51
52
53






















54
55
56

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, SynEdit, Forms, Controls, ExtCtrls, ComCtrls,
  StdCtrls,
  M_Main;

type

  { TframeCommitMessage }

  TframeCommitMessage = class(TFrame)
    btnCommit: TButton;

    pnlOptions: TPanel;
    sbrMessage: TStatusBar;
    synMessage: TSynEdit;
    tbrMessage: TToolBar;
    btnBranch: TToolButton;
    btnOptions: TToolButton;
    btnSep1: TToolButton;
    btnMessage: TToolButton;


  private


    { private declarations }
  public
    { public declarations }
    constructor Create(AOwner: TComponent); override;


  end;

implementation

{$R *.lfm}

{ TframeCommitMessage }
................................................................................
    for i := Low(cFontNames) to High(cFontNames) do begin
      if Screen.Fonts.IndexOf(cFontNames[i]) > -1 then begin
        synMessage.Font.Name := cFontNames[i];
        Break;
      end;
    end;
end {TframeCommitMessage.Create};























end.








|
|







>








>
>

>
>




>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
..
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, SynEdit, Forms, Controls, ExtCtrls, ComCtrls,
  StdCtrls, ColorBox,
  M_Main, U_Fossil;

type

  { TframeCommitMessage }

  TframeCommitMessage = class(TFrame)
    btnCommit: TButton;
    cbxColor: TColorBox;
    pnlOptions: TPanel;
    sbrMessage: TStatusBar;
    synMessage: TSynEdit;
    tbrMessage: TToolBar;
    btnBranch: TToolButton;
    btnOptions: TToolButton;
    btnSep1: TToolButton;
    btnMessage: TToolButton;
    procedure btnCommitClick(Sender: TObject);
    procedure synMessageChange(Sender: TObject);
  private
    FWorkdir: TFossilWorkdir;
    procedure SetWorkdir(AValue: TFossilWorkdir);
    { private declarations }
  public
    { public declarations }
    constructor Create(AOwner: TComponent); override;

    property WorkDir: TFossilWorkdir  read FWorkdir write SetWorkdir;
  end;

implementation

{$R *.lfm}

{ TframeCommitMessage }
................................................................................
    for i := Low(cFontNames) to High(cFontNames) do begin
      if Screen.Fonts.IndexOf(cFontNames[i]) > -1 then begin
        synMessage.Font.Name := cFontNames[i];
        Break;
      end;
    end;
end {TframeCommitMessage.Create};

procedure TframeCommitMessage.SetWorkdir(AValue: TFossilWorkdir);
begin
  if FWorkdir = AValue then Exit;
  FWorkdir := AValue;

  // TODO: display current branch name
  sbrMessage.SimpleText := FWorkdir.Branch;

  // TODO: if we can determine the current background color, set it as the 'None' color
  // TODO: ...?
end;

procedure TframeCommitMessage.synMessageChange(Sender: TObject);
begin
  btnCommit.Enabled := Length(TrimRight(synMessage.Text)) > 0;
end;

procedure TframeCommitMessage.btnCommitClick(Sender: TObject);
begin
  // TODO: FRevision.Commit(Options);
end;

end.

Changes to src/f_commit.lfm.

33
34
35
36
37
38
39















40
41
42
43
44
45
46
..
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
        Width = 250
        Align = alClient
        ClientHeight = 462
        ClientWidth = 250
        inherited lvwFiles: TListView
          Height = 436
          Width = 250















        end
        inherited tbrFiles: TToolBar
          Width = 250
          inherited btnStatus: TToolButton
            AllowAllUp = False
          end
        end
................................................................................
            Align = alClient
            ClientHeight = 200
            ClientWidth = 446
            inherited pnlOptions: TPanel
              Width = 446
              ClientWidth = 446
              inherited tbrMessage: TToolBar
                Width = 444
              end
              inherited btnCommit: TButton
                Left = 363
              end
            end
            inherited sbrMessage: TStatusBar
              Top = 185







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
        Width = 250
        Align = alClient
        ClientHeight = 462
        ClientWidth = 250
        inherited lvwFiles: TListView
          Height = 436
          Width = 250
          Columns = <          
            item
              Caption = 'Name'
              MinWidth = 50
              Width = 150
            end          
            item
              Caption = 'Status'
              Width = 20
            end          
            item
              Caption = 'Path'
              ImageIndex = 11
              Width = 80
            end>
        end
        inherited tbrFiles: TToolBar
          Width = 250
          inherited btnStatus: TToolButton
            AllowAllUp = False
          end
        end
................................................................................
            Align = alClient
            ClientHeight = 200
            ClientWidth = 446
            inherited pnlOptions: TPanel
              Width = 446
              ClientWidth = 446
              inherited tbrMessage: TToolBar
                Width = 446
              end
              inherited btnCommit: TButton
                Left = 363
              end
            end
            inherited sbrMessage: TStatusBar
              Top = 185

Changes to src/f_commit.pas.

42
43
44
45
46
47
48

49
50
51
52
53
54
55
56
57
58

{ TfrmCommit }

procedure TfrmCommit.FormCreate(Sender: TObject);
begin
  frameFileList.OnSelectionChanged := @frameFileListSelectionChanged;
  frameFileList.Revision := modMain.Checkout.Workdir;

end;

procedure TfrmCommit.frameFileListSelectionChanged(Sender: TObject;
  AFile: TFileVersion; Selected: Boolean);
begin
  frameFileVersionInfo.SelectFile(AFile, Selected);
end;

end.








>










42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

{ TfrmCommit }

procedure TfrmCommit.FormCreate(Sender: TObject);
begin
  frameFileList.OnSelectionChanged := @frameFileListSelectionChanged;
  frameFileList.Revision := modMain.Checkout.Workdir;
  fraCommitMessage.WorkDir := modMain.Checkout.Workdir;
end;

procedure TfrmCommit.frameFileListSelectionChanged(Sender: TObject;
  AFile: TFileVersion; Selected: Boolean);
begin
  frameFileVersionInfo.SelectFile(AFile, Selected);
end;

end.

Changes to src/u_fossil.pas.

134
135
136
137
138
139
140
141

142
143
144
145
146
147
148
149

150
151
152
153
154
155
156
...
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
...
199
200
201
202
203
204
205

206
207
208
209
210
211
212
...
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
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412




413
414
415
416
417
418
419
...
611
612
613
614
615
616
617



618


619
620
621
622
623
624
625
626
627
628
...
726
727
728
729
730
731
732


733
734
735
736
737
738

739






740
741
742
743
744
745
746
...
801
802
803
804
805
806
807

















808
809
810
811
812
813
814
...
954
955
956
957
958
959
960





















961
962
963
964
965
966
967
....
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110

1111

1112
1113

1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126


1127
1128


1129
1130
1131
1132
1133
1134
1135

1136
1137
1138
1139
1140
1141
1142
1143


1144
1145
1146

1147
1148



1149
1150
1151

1152
1153
1154
1155
1156
1157
1158
1159
    FTags: TStringList;
    FDateTimeUTC: TDateTime;
    FDateTime: TDateTime;
    FUser: string;
    FMessage: string;
    FBranch: string;

    function GetCurrent: Boolean;

    procedure SetCurrent(AValue: Boolean);
    procedure SetDateTime(AValue: TDateTime);
    procedure SetDateTimeUTC(AValue: TDateTime);
  protected
    FLoadedStates: TFossilFileStates;

    function GetParentUUID: string; virtual;
    function GetParent: TFossilRevision; virtual;

    function GetFiles: TFossilFileList; virtual;
  public
    constructor Create(const ACheckout: TFossilCheckout); override;
    destructor  Destroy; override;

    function LoadFilesFromTimeline(const Timeline: TStrings; var AIndex: Integer; const LeaveExisting: Boolean): Integer;

................................................................................
    property IsCurrent: Boolean       read GetCurrent     write SetCurrent;
    property Files: TFossilFileList   read GetFiles;

    property DateTimeUTC: TDateTime   read FDateTimeUTC   write SetDateTimeUTC;
    property DateTimeLocal: TDateTime read FDateTime      write SetDateTime;
    property Message: string          read FMessage       write FMessage;
    property User: string             read FUser          write FUser;
    property Branch: string           read FBranch        write FBranch;
    property Tags: TStringList        read FTags;
  public
    function  LoadFiles(const States: TFossilFileStates = ffsPending; const ForceRefresh: Boolean = False): Integer; virtual;
  end;


type
  TCommitFlag = (cfAllowConflict, cfAllowEmpty, cfAllowFork, cfAllowOlder, cfBaselineManifest, cfDeltaManifest, cfDryRun, cfNoSign, cfNoWarnings, cfPrivate, cfSHA1Sum);
................................................................................
    );

type
  { TFossilWorkdir }

  TFossilWorkdir = class(TFossilRevision)
  protected

    function GetParentUUID: string; override;
  public
    function  LoadFiles(const States: TFossilFileStates = ffsPending; const ForceRefresh: Boolean = False): Integer; override;

    function  Commit(const Options: PCommitOptions; const ATags: TStrings = nil; const AFiles: TFossilFileList = nil): string;
  end;

................................................................................
      P.Options := P.Options + [poUsePipes];
      P.StartupOptions := [suoUseShowWindow];
      P.ShowWindow := swoHIDE;

      P.Execute;
      while P.Running do begin
        n := CacheStream(P.Output, OMS, BytesRead);

        Inc(n, CacheStream(P.Stderr, EMS, ErrBytesRead));

        if n <= 0 then begin
          // no data, wait 100 ms
          Sleep(100);
        end;
      end;
      // read last part
      repeat
        n := CacheStream(P.Output, OMS, BytesRead);

        Inc(n, CacheStream(P.Stderr, EMS, ErrBytesRead));

      until n <= 0;

      OMS.SetSize(BytesRead);
      EMS.SetSize(ErrBytesRead);
    finally
      P.Free;
    end;

    S := TStringStream.Create('');
    try
      S.CopyFrom(OMS, OMS.Size);
      S.Position := 0;
      Result := S.ReadString(S.Size);
    finally
      S.Free;
    end;

    // MessageBoxFunction(PChar(FCurDir + '> TFossil.Run(' + Command + ')'), PChar(Result), 64);

    if EMS.Size > 0 then begin
      S := TStringStream.Create('');
      try
        S.CopyFrom(EMS, EMS.Size);
        S.Position := 0;
        Msg := S.ReadString(S.Size);
        if SameFileName(Copy(Msg, 2, Length(FExePath)), FExePath) then begin
          Msg := Copy(Msg, Length(FExePath) + 3, Length(Msg));
        end;
        raise EFossilError.Create(Msg + sLineBreak + sLineBreak + Result);
      finally
        S.Free;
      end;




    end;
  finally
    OMS.Free;
    EMS.Free;
  end;

  // Trim all whitespace, including tabs and newlines
................................................................................
var
  i: Integer;
begin
  if not Assigned(FInfo) then begin
    FInfo := TStringList.Create;
    FInfo.NameValueSeparator := ':';
    FInfo.Text := FFossil.Run('info');



    for i := FInfo.Count - 1 downto 0 do begin


      FInfo.ValueFromIndex[i] := TrimLeft(FInfo.ValueFromIndex[i]);
    end;
    // TODO: wrapped lines!
  end;
  Result := FInfo;
end;

function TFossilCheckout.GetRevisions: TFossilRevisionList;
begin
  if not Assigned(FRevisions) then begin
................................................................................
begin
  if Assigned(FInfo) then
    FInfo.Free;
  inherited Destroy;
end;

function TFossilObject.GetInfo: TStringList;


begin
  if not Assigned(FInfo) then begin
    Assert(UUID <> '', 'No UUID known for this object!');
    FInfo := TStringList.Create;
    FInfo.NameValueSeparator := ':';
    FInfo.Text := FCheckout.Exe.Run('info ' + UUID);

    // TODO: wrapped lines!






  end;
  Result := FInfo;
end;

function TFossilObject.CompareUUID(const OtherUUID: string): Integer;
var count, count1, count2: integer;
begin
................................................................................
  Result := FFiles;
end;

function TFossilRevision.GetCurrent: Boolean;
begin
  Result := (FCheckout.CurrentRevision = Self);
end;


















procedure TFossilRevision.SetCurrent(AValue: Boolean);
begin
  if AValue then
    FCheckout.CurrentRevision := Self
  else if IsCurrent then
    FCheckout.CurrentRevision := nil;
................................................................................
  end;

  FLoadedStates := States * [ffsChanged, ffsUnchanged];
end {TFossilRevision.LoadFiles};


{ TFossilWorkdir }






















function TFossilWorkdir.GetParentUUID: string;
var
  CharPos: Integer;
begin
  if FParentUUID = '' then begin
    FParentUUID := Checkout.Info.Values['checkout'];
................................................................................
          Ignored.Free;
      end;
    end;

    // Free any remaining old files
    for i := Existing.Count - 1 downto 0 do begin
      OldFile := TWorkFile(Existing.Objects[i]);
      if not ForceRefresh {and ...} then begin
        // TODO: if its status matches FLoadedStates but not NewStates,
        //  then we shouldn't free it, but add it to the list.

      end;

      // TODO: notify the file('s users) of its imminent freedom?
      OldFile.Free;

    end;
  finally
    Existing.Free;
  end;

  // keep track of the requested states, so we know to only request what's new when ForceRefresh = False
  if ForceRefresh then
    FLoadedStates := NewStates
  else
    FLoadedStates := FLoadedStates + NewStates;
end;

function ColorToHex(const Color: TColor): string;


begin
  // TODO: return HTML hex-notation of Color (first do ColorToRGB?)


end;

function TFossilWorkdir.Commit(const Options: PCommitOptions;
  const ATags: TStrings = nil; const AFiles: TFossilFileList = nil): string;
var
  Cmd: string;
  MsgFile: TFileName;

  FS: TFileStream;
  i: Integer;
  Flag: TCommitFlag;
begin
  Cmd := 'commit';

  // TODO: save the commit message to a temp file, and refer to that
  MsgFile := GetTempFilename(GetTempDir, 'msg');


  FS := TFileStream.Create(MsgFile, fmCreate or fmOpenWrite or fmShareDenyWrite);
  try
    FS.WriteAnsiString(Options^.Message);

  finally
    FS.Free;



  end;
  try
    Cmd += ' --message-file ' + AnsiQuotedStr(MsgFile, '"');

    Cmd += ' --mimetype ' + Options^.ContentType;

    if Options^.BranchName <> '' then begin
      Cmd += ' --branch ' + Options^.BranchName;
      if Options^.BranchColor <> clNone then begin
        Cmd += ' --branchcolor ' + ColorToHex(Options^.BranchColor);
      end;
    end;







|
>
|







>







 







|
|







 







>







 







>

>








>

>












|











|
<
<
<
<



>
>
>
>







 







>
>
>

>
>
|

<







 







>
>






>

>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







<
|
|
>
|
>
|
|
>













>
>

|
>
>







>






|

>
>
|
|
<
>
|
|
>
>
>



>
|







134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
...
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
...
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
...
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
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412




413
414
415
416
417
418
419
420
421
422
423
424
425
426
...
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632

633
634
635
636
637
638
639
...
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
...
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
...
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
....
1159
1160
1161
1162
1163
1164
1165

1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212

1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
    FTags: TStringList;
    FDateTimeUTC: TDateTime;
    FDateTime: TDateTime;
    FUser: string;
    FMessage: string;
    FBranch: string;

    function GetCurrent: Boolean; virtual;
    function GetTags: TStringList;
    procedure SetCurrent(AValue: Boolean); virtual; // TODO: checkout? update?
    procedure SetDateTime(AValue: TDateTime);
    procedure SetDateTimeUTC(AValue: TDateTime);
  protected
    FLoadedStates: TFossilFileStates;

    function GetParentUUID: string; virtual;
    function GetParent: TFossilRevision; virtual;
    function GetBranch: string; virtual;
    function GetFiles: TFossilFileList; virtual;
  public
    constructor Create(const ACheckout: TFossilCheckout); override;
    destructor  Destroy; override;

    function LoadFilesFromTimeline(const Timeline: TStrings; var AIndex: Integer; const LeaveExisting: Boolean): Integer;

................................................................................
    property IsCurrent: Boolean       read GetCurrent     write SetCurrent;
    property Files: TFossilFileList   read GetFiles;

    property DateTimeUTC: TDateTime   read FDateTimeUTC   write SetDateTimeUTC;
    property DateTimeLocal: TDateTime read FDateTime      write SetDateTime;
    property Message: string          read FMessage       write FMessage;
    property User: string             read FUser          write FUser;
    property Branch: string           read GetBranch      write FBranch;
    property Tags: TStringList        read GetTags;
  public
    function  LoadFiles(const States: TFossilFileStates = ffsPending; const ForceRefresh: Boolean = False): Integer; virtual;
  end;


type
  TCommitFlag = (cfAllowConflict, cfAllowEmpty, cfAllowFork, cfAllowOlder, cfBaselineManifest, cfDeltaManifest, cfDryRun, cfNoSign, cfNoWarnings, cfPrivate, cfSHA1Sum);
................................................................................
    );

type
  { TFossilWorkdir }

  TFossilWorkdir = class(TFossilRevision)
  protected
    function GetInfo: TStringList; override;
    function GetParentUUID: string; override;
  public
    function  LoadFiles(const States: TFossilFileStates = ffsPending; const ForceRefresh: Boolean = False): Integer; override;

    function  Commit(const Options: PCommitOptions; const ATags: TStrings = nil; const AFiles: TFossilFileList = nil): string;
  end;

................................................................................
      P.Options := P.Options + [poUsePipes];
      P.StartupOptions := [suoUseShowWindow];
      P.ShowWindow := swoHIDE;

      P.Execute;
      while P.Running do begin
        n := CacheStream(P.Output, OMS, BytesRead);
        // TODO: if Assigned(OnFossilOutput) then OnFossilOutput(Self, False, OMS, n, P.Input);
        Inc(n, CacheStream(P.Stderr, EMS, ErrBytesRead));
        // TODO: if Assigned(OnFossilOutput) then OnFossilOutput(Self, True, EMS, n, P.Input);
        if n <= 0 then begin
          // no data, wait 100 ms
          Sleep(100);
        end;
      end;
      // read last part
      repeat
        n := CacheStream(P.Output, OMS, BytesRead);
        // TODO: if Assigned(OnFossilOutput) then OnFossilOutput(Self, False, OMS, n, P.Input);
        Inc(n, CacheStream(P.Stderr, EMS, ErrBytesRead));
        // TODO: if Assigned(OnFossilOutput) then OnFossilOutput(Self, True, EMS, n, P.Input);
      until n <= 0;

      OMS.SetSize(BytesRead);
      EMS.SetSize(ErrBytesRead);
    finally
      P.Free;
    end;

    S := TStringStream.Create('');
    try
      S.CopyFrom(OMS, OMS.Size);
      S.Position := 0;
      Result := S.DataString;
    finally
      S.Free;
    end;

    // MessageBoxFunction(PChar(FCurDir + '> TFossil.Run(' + Command + ')'), PChar(Result), 64);

    if EMS.Size > 0 then begin
      S := TStringStream.Create('');
      try
        S.CopyFrom(EMS, EMS.Size);
        S.Position := 0;
        Msg := S.DataString;




      finally
        S.Free;
      end;
      if SameFileName(Copy(Msg, 2, Length(FExePath)), FExePath) then begin
        Msg := Copy(Msg, Length(FExePath) + 3, Length(Msg));
      end;
      raise EFossilError.Create(Trim(Msg + sLineBreak + sLineBreak + Result));
    end;
  finally
    OMS.Free;
    EMS.Free;
  end;

  // Trim all whitespace, including tabs and newlines
................................................................................
var
  i: Integer;
begin
  if not Assigned(FInfo) then begin
    FInfo := TStringList.Create;
    FInfo.NameValueSeparator := ':';
    FInfo.Text := FFossil.Run('info');

    // TODO: correctly process wrapped lines!

    for i := FInfo.Count - 1 downto 0 do begin
      FInfo[i] := TrimRight(FInfo.Names[i])
                  + FInfo.NameValueSeparator
                  + TrimLeft(FInfo.ValueFromIndex[i]);
    end;

  end;
  Result := FInfo;
end;

function TFossilCheckout.GetRevisions: TFossilRevisionList;
begin
  if not Assigned(FRevisions) then begin
................................................................................
begin
  if Assigned(FInfo) then
    FInfo.Free;
  inherited Destroy;
end;

function TFossilObject.GetInfo: TStringList;
var
  i: Integer;
begin
  if not Assigned(FInfo) then begin
    Assert(UUID <> '', 'No UUID known for this object!');
    FInfo := TStringList.Create;
    FInfo.NameValueSeparator := ':';
    FInfo.Text := FCheckout.Exe.Run('info ' + UUID);

    // TODO: wrapped lines!

    for i := FInfo.Count - 1 downto 0 do begin
      FInfo[i] := TrimRight(FInfo.Names[i])
                  + FInfo.NameValueSeparator
                  + TrimLeft(FInfo.ValueFromIndex[i]);
    end;
  end;
  Result := FInfo;
end;

function TFossilObject.CompareUUID(const OtherUUID: string): Integer;
var count, count1, count2: integer;
begin
................................................................................
  Result := FFiles;
end;

function TFossilRevision.GetCurrent: Boolean;
begin
  Result := (FCheckout.CurrentRevision = Self);
end;

function TFossilRevision.GetTags: TStringList;
begin
  if not Assigned(FTags) then begin
    FTags := TStringList.Create;
  end;
  if FTags.Count = 0 then begin
    FTags.Delimiter := ',';
    FTags.DelimitedText := Info.Values['tags'];
  end;
  Result := FTags;
end;

function TFossilRevision.GetBranch: string;
begin
  Result := Trim(Tags[0]);
end;

procedure TFossilRevision.SetCurrent(AValue: Boolean);
begin
  if AValue then
    FCheckout.CurrentRevision := Self
  else if IsCurrent then
    FCheckout.CurrentRevision := nil;
................................................................................
  end;

  FLoadedStates := States * [ffsChanged, ffsUnchanged];
end {TFossilRevision.LoadFiles};


{ TFossilWorkdir }

function TFossilWorkdir.GetInfo: TStringList;
var
  i: Integer;
begin
  if not Assigned(FInfo) then begin
    FInfo := TStringList.Create;
    FInfo.NameValueSeparator := ':';
    FInfo.Text := FCheckout.Exe.Run('info');

    // TODO: correctly process wrapped lines!

    // Remove extraneous spaces
    for i := FInfo.Count - 1 downto 0 do begin
      FInfo[i] := TrimRight(FInfo.Names[i])
                  + FInfo.NameValueSeparator
                  + TrimLeft(FInfo.ValueFromIndex[i]);
    end;
  end;
  Result := FInfo;
end;

function TFossilWorkdir.GetParentUUID: string;
var
  CharPos: Integer;
begin
  if FParentUUID = '' then begin
    FParentUUID := Checkout.Info.Values['checkout'];
................................................................................
          Ignored.Free;
      end;
    end;

    // Free any remaining old files
    for i := Existing.Count - 1 downto 0 do begin
      OldFile := TWorkFile(Existing.Objects[i]);

      // TODO: if its status matches FLoadedStates but not NewStates,
      //  then we shouldn't free it, but add it to the list.
//      if not ForceRefresh {and ...} then begin
//        Files.Add(OldFile);
//      end else begin
        // TODO: notify the file('s users) of its imminent freedom?
        OldFile.Free;
//      end;
    end;
  finally
    Existing.Free;
  end;

  // keep track of the requested states, so we know to only request what's new when ForceRefresh = False
  if ForceRefresh then
    FLoadedStates := NewStates
  else
    FLoadedStates := FLoadedStates + NewStates;
end;

function ColorToHex(const Color: TColor): string;
var
  R, G, B: Byte;
begin
  // return HTML hex-notation of Color (HTML has the colors in the inverse direction of Pascal)
  RedGreenBlue(Color, R, G, B);
  Result := '#' + HexStr(RGBToColor(G, B, R), 6);
end;

function TFossilWorkdir.Commit(const Options: PCommitOptions;
  const ATags: TStrings = nil; const AFiles: TFossilFileList = nil): string;
var
  Cmd: string;
  MsgFile: TFileName;
  SS: TStringStream;
  FS: TFileStream;
  i: Integer;
  Flag: TCommitFlag;
begin
  Cmd := 'commit';

  // save the commit message to a temp file, and refer to that
  MsgFile := GetTempFilename(GetTempDir, 'msg');
  SS := TStringStream.Create(Options^.Message);
  try
    FS := TFileStream.Create(MsgFile, fmCreate or fmOpenWrite or fmShareDenyWrite);
    try

      FS.CopyFrom(SS, 0);
    finally
      FS.Free;
    end;
  finally
    SS.Free;
  end;
  try
    Cmd += ' --message-file ' + AnsiQuotedStr(MsgFile, '"');
    if Options^.ContentType <> '' then
      Cmd += ' --mimetype ' + Options^.ContentType;

    if Options^.BranchName <> '' then begin
      Cmd += ' --branch ' + Options^.BranchName;
      if Options^.BranchColor <> clNone then begin
        Cmd += ' --branchcolor ' + ColorToHex(Options^.BranchColor);
      end;
    end;