← Back to branch summary

~ubuntu-branches/ubuntu/vivid/lazarus/vivid

« back to all changes in this revision

Viewing changes to ide/etsrceditmarks.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Paul Gevers
  • Date: 2014-02-22 10:25:57 UTC
  • mfrom: (1.1.11)
  • Revision ID: package-import@ubuntu.com-20140222102557-ors9d31r84nz31jq
Tags: 1.2~rc2+dfsg-1
http://bugs.debian.org/724776
[ Abou Al Montacir ]
* New upstream pre-release.
  + Moved ideintf to components directory.
  + Added new package cairocanvas.
* Remove usage of depreciated parameters form of find. (Closes: Bug#724776)
* Bumped standard version to 3.9.5.
* Clean the way handling make files generation and removal.

[ Paul Gevers ]
* Remove nearly obsolete bzip compression for binary packages
  (See https://lists.debian.org/debian-devel/2014/01/msg00542.html)
* Update d/copyright for newly added dir in examples and components
* Update Vcs-* fields with new packaging location
* Update d/watch file to properly (Debian way) change upstreams versions
* Prevent 46MB of package size by sym linking duplicate files
* Patches
  - refresh to remove fuzz
  - add more Lintian found spelling errors
  - new patch to add shbang to two scripts in lazarus-src
* Drop lcl-# from Provides list of lcl-units-#
* Make lazarus-ide-qt4-# an arch all until it really contains stuff
* Make all metapackages arch all as the usecase for arch any doesn't
  seem to warrant the addition archive hit
* Fix permissions of non-scripts in lazarus-src-#

Show diffs side-by-side

added added

removed removed

Lines of Context:
ide/etsrceditmarks.pas
 
1
{
 
2
 ***************************************************************************
 
3
 *                                                                         *
 
4
 *   This source is free software; you can redistribute it and/or modify   *
 
5
 *   it under the terms of the GNU General Public License as published by  *
 
6
 *   the Free Software Foundation; either version 2 of the License, or     *
 
7
 *   (at your option) any later version.                                   *
 
8
 *                                                                         *
 
9
 *   This code is distributed in the hope that it will be useful, but      *
 
10
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 
11
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 
12
 *   General Public License for more details.                              *
 
13
 *                                                                         *
 
14
 *   A copy of the GNU General Public License is available on the World    *
 
15
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 
16
 *   obtain it by writing to the Free Software Foundation,                 *
 
17
 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 
18
 *                                                                         *
 
19
 ***************************************************************************
 
20
 
 
21
  Author: Mattias Gaertner
 
22
 
 
23
  Abstract:
 
24
    Source Editor marks for (compiler) messages.
 
25
}
 
26
unit etSrcEditMarks;
 
27
 
 
28
{$mode objfpc}{$H+}
 
29
 
 
30
interface
 
31
 
 
32
uses
 
33
  Classes, SysUtils, math, SynGutterLineOverview, SynEditMarkupGutterMark,
 
34
  SynEditMarks, SynEditMiscClasses, SynEditTypes, SynEdit, LazSynEditText,
 
35
  LazLogger, LazFileUtils, AvgLvlTree, Graphics, Controls, Forms, ImgList,
 
36
  IDEExternToolIntf;
 
37
 
 
38
type
 
39
 
 
40
  { TETMarkStyle }
 
41
 
 
42
  TETMarkStyle = class
 
43
  private
 
44
    FColor: TColor;
 
45
    FImageIndex: integer;
 
46
    FSourceMarkup: TSynSelectedColor;
 
47
    FUrgency: TMessageLineUrgency;
 
48
    procedure SetColor(AValue: TColor);
 
49
  public
 
50
    constructor Create(TheUrgency: TMessageLineUrgency; TheColor: TColor);
 
51
    destructor Destroy; override;
 
52
    property Urgency: TMessageLineUrgency read FUrgency;
 
53
    property Color: TColor read FColor write SetColor;
 
54
    property ImageIndex: integer read FImageIndex write FImageIndex;
 
55
    property SourceMarkup: TSynSelectedColor read FSourceMarkup;
 
56
  end;
 
57
 
 
58
  TETMarks = class;
 
59
 
 
60
  { TETMark }
 
61
 
 
62
  TETMark = class(TSynEditMarkupMark)
 
63
  private
 
64
    FMsgLine: TMessageLine;
 
65
    FSourceMarks: TETMarks;
 
66
    FUrgency: TMessageLineUrgency;
 
67
  public
 
68
    destructor Destroy; override;
 
69
    property Urgency: TMessageLineUrgency read FUrgency write FUrgency;
 
70
    property MsgLine: TMessageLine read FMsgLine write FMsgLine;
 
71
    property SourceMarks: TETMarks read FSourceMarks write FSourceMarks;
 
72
  end;
 
73
 
 
74
  { TLMsgViewLine }
 
75
 
 
76
  TLMsgViewLine = class(TMessageLine)
 
77
  public
 
78
    Mark: TETMark;
 
79
    destructor Destroy; override;
 
80
  end;
 
81
 
 
82
  { TETMarks }
 
83
 
 
84
  TOnGetSynEditOfFile = procedure(Sender: TObject; aFilename: string;
 
85
    var aSynEdit: TSynEdit) of object;
 
86
 
 
87
  TETMarks = class(TComponent)
 
88
  private
 
89
    FImageList: TCustomImageList;
 
90
    fMarkStyles: array[TMessageLineUrgency] of TETMarkStyle;
 
91
    FOnGetSynEditOfFile: TOnGetSynEditOfFile;
 
92
    FPriority: integer;
 
93
    function GetMarkStyles(Urgency: TMessageLineUrgency): TETMarkStyle;
 
94
  public
 
95
    constructor Create(AOwner: TComponent); override;
 
96
    destructor Destroy; override;
 
97
    function CreateMark(MsgLine: TMessageLine; aSynEdit: TSynEdit = nil): TETMark;
 
98
    procedure RemoveMarks(aSynEdit: TSynEdit);
 
99
    property ImageList: TCustomImageList read FImageList write FImageList; // must have same Width/Height as the TSynEdits bookmarkimages
 
100
    property OnGetSynEditOfFile: TOnGetSynEditOfFile read FOnGetSynEditOfFile write FOnGetSynEditOfFile;
 
101
    property MarkStyles[Urgency: TMessageLineUrgency]: TETMarkStyle read GetMarkStyles;
 
102
    property Priority: integer read FPriority write FPriority;
 
103
  end;
 
104
 
 
105
  { TExtToolSynGutterMarkProvider }
 
106
 
 
107
  TExtToolSynGutterMarkProvider = class(TSynGutterLOvProviderBookmarks)
 
108
  protected
 
109
    procedure AdjustColorForMark(AMark: TSynEditMark; var AColor: TColor;
 
110
      var APriority: Integer); override;
 
111
  end;
 
112
 
 
113
  TETSrcChangeAction = (
 
114
    etscaInsert,
 
115
    etscaDelete
 
116
    );
 
117
 
 
118
  { TETSrcChange }
 
119
 
 
120
  TETSrcChange = class
 
121
  public
 
122
    Action: TETSrcChangeAction;
 
123
    FromPos: TPoint;
 
124
    ToPos: TPoint;
 
125
    Prev, Next: TETSrcChange;
 
126
    constructor Create(AnAction: TETSrcChangeAction; const aFromPos, aToPos: TPoint);
 
127
    constructor Create(AnAction: TETSrcChangeAction; FromPosY, FromPosX, ToPosY, ToPosX: integer);
 
128
    function AsString: string;
 
129
  end;
 
130
 
 
131
  { TETSrcChanges - edits of single file}
 
132
 
 
133
  TETSrcChanges = class
 
134
  private
 
135
    FFilename: string;
 
136
    FFirst: TETSrcChange;
 
137
    FLast: TETSrcChange;
 
138
    procedure Append(Change: TETSrcChange);
 
139
    procedure Remove(Change: TETSrcChange);
 
140
    procedure SetFilename(AValue: string);
 
141
  public
 
142
    constructor Create;
 
143
    destructor Destroy; override;
 
144
    procedure Clear;
 
145
    property First: TETSrcChange read FFirst;
 
146
    property Last: TETSrcChange read FLast;
 
147
    property Filename: string read FFilename write SetFilename;
 
148
    procedure GetRange(out MinY, MaxY, LineDiffBehindMaxY: integer);
 
149
    function Add(Action: TETSrcChangeAction; const FromPos, ToPos: TPoint): TETSrcChange; inline;
 
150
    function Add(Action: TETSrcChangeAction; FromPosY, FromPosX, ToPosY, ToPosX: integer): TETSrcChange;
 
151
    function AdaptCaret(var Line,Col: integer;
 
152
      LeftBound: boolean // true = position is bound to character on the left
 
153
                 ): boolean; // true if changed
 
154
    procedure ConsistencyCheck;
 
155
    procedure WriteDebugReport(Title: string);
 
156
  end;
 
157
 
 
158
  { TETMultiSrcChanges - edits of all files }
 
159
 
 
160
  TETMultiSrcChanges = class
 
161
  private
 
162
    fAllChanges: TAvgLvlTree; // tree of TETSrcChanges sorted for Filename
 
163
  public
 
164
    constructor Create;
 
165
    destructor Destroy; override;
 
166
    function Count: integer; inline;
 
167
    procedure Clear;
 
168
    function GetChanges(const aFilename: string; CreateIfNotExists: boolean): TETSrcChanges;
 
169
    function AdaptCaret(const aFilename: string; var Line,Col: integer;
 
170
      LeftBound: boolean // true = position is bound to character on the left
 
171
                 ): boolean;
 
172
    property AllChanges: TAvgLvlTree read fAllChanges; // tree of TETSrcChanges sorted for Filename
 
173
  end;
 
174
 
 
175
  { TETSynPlugin - create one per file, not one per synedit }
 
176
 
 
177
  TETSynPlugin = class(TLazSynEditPlugin)
 
178
  private
 
179
    FChanges: TETSrcChanges;
 
180
    FOnChanged: TNotifyEvent;
 
181
    FSyncQueued: boolean;
 
182
    procedure SetSyncQueued(AValue: boolean);
 
183
  protected
 
184
    procedure DoSync({%H-}Data: PtrInt); // called by Application.QueueAsyncCall
 
185
    procedure OnLineEdit(Sender: TSynEditStrings; aLinePos, aBytePos, aCount,
 
186
      aLineBrkCnt: Integer; {%H-}aText: String);
 
187
  public
 
188
    constructor Create(AOwner: TComponent); override;
 
189
    destructor Destroy; override;
 
190
    property Changes: TETSrcChanges read FChanges;
 
191
    property SyncQueued: boolean read FSyncQueued write SetSyncQueued;
 
192
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; // called by Application.QueueAsyncCall
 
193
  end;
 
194
 
 
195
function IsCaretInFront(Line1, Col1, Line2, Col2: integer): boolean; inline; overload;
 
196
function IsCaretInFront(const P1: TPoint; Line2, Col2: integer): boolean; inline; overload;
 
197
function IsCaretInFront(Line1, Col1: integer; const P2: TPoint): boolean; inline; overload;
 
198
function IsCaretInFront(const P1,P2: TPoint): boolean; inline; overload;
 
199
function IsCaretInFrontOrSame(Line1, Col1, Line2, Col2: integer): boolean; inline; overload;
 
200
function IsCaretInFrontOrSame(const P1: TPoint; Line2, Col2: integer): boolean; inline; overload;
 
201
function IsCaretInFrontOrSame(Line1, Col1: integer; const P2: TPoint): boolean; inline; overload;
 
202
function IsCaretInFrontOrSame(const P1,P2: TPoint): boolean; inline; overload;
 
203
procedure AdaptCaret(var Line,Col: integer;
 
204
  LeftBound: boolean; // true = position is bound to character on the left
 
205
  Action: TETSrcChangeAction;
 
206
  FromPosY, FromPosX, ToPosY, ToPosX: integer);
 
207
 
 
208
function CompareETSrcChangesFilenames(Changes1, Changes2: Pointer): integer;
 
209
function CompareFilenameAndETSrcChanges(aFilenameStr, Changes: Pointer): integer;
 
210
 
 
211
function dbgs(Action: TETSrcChangeAction): string; overload;
 
212
procedure Test_AdaptCaret;
 
213
procedure Test_MergeTETSrcChanges;
 
214
 
 
215
implementation
 
216
 
 
217
function IsCaretInFront(Line1, Col1, Line2, Col2: integer): boolean;
 
218
begin
 
219
  Result:=(Line1<Line2) or ((Line1=Line2) and (Col1<Col2));
 
220
end;
 
221
 
 
222
function IsCaretInFront(const P1: TPoint; Line2, Col2: integer): boolean;
 
223
begin
 
224
  Result:=IsCaretInFront(P1.Y,P1.X,Line2,Col2);
 
225
end;
 
226
 
 
227
function IsCaretInFront(Line1, Col1: integer; const P2: TPoint): boolean;
 
228
begin
 
229
  Result:=IsCaretInFront(Line1,Col1,P2.Y,P2.X);
 
230
end;
 
231
 
 
232
function IsCaretInFront(const P1, P2: TPoint): boolean;
 
233
begin
 
234
  Result:=IsCaretInFront(P1.Y,P1.X,P2.Y,P2.X);
 
235
end;
 
236
 
 
237
function IsCaretInFrontOrSame(Line1, Col1, Line2, Col2: integer): boolean;
 
238
begin
 
239
  Result:=(Line1<Line2) or ((Line1=Line2) and (Col1<=Col2));
 
240
end;
 
241
 
 
242
function IsCaretInFrontOrSame(const P1: TPoint; Line2, Col2: integer): boolean;
 
243
begin
 
244
  Result:=IsCaretInFrontOrSame(P1.Y,P1.X,Line2,Col2);
 
245
end;
 
246
 
 
247
function IsCaretInFrontOrSame(Line1, Col1: integer; const P2: TPoint): boolean;
 
248
begin
 
249
  Result:=IsCaretInFrontOrSame(Line1,Col1,P2.Y,P2.X);
 
250
end;
 
251
 
 
252
function IsCaretInFrontOrSame(const P1, P2: TPoint): boolean;
 
253
begin
 
254
  Result:=IsCaretInFrontOrSame(P1.Y,P1.X,P2.Y,P2.X);
 
255
end;
 
256
 
 
257
procedure AdaptCaret(var Line, Col: integer; LeftBound: boolean;
 
258
  Action: TETSrcChangeAction; FromPosY, FromPosX, ToPosY, ToPosX: integer);
 
259
begin
 
260
  //debugln(['AdaptCaret Line=',Line,' Col=',Col,' LeftBound=',LeftBound,' Action=',dbgs(Action),' FromPos=',FromPosY,',',FromPosX,' ToPos=',ToPosY,',',ToPosX]);
 
261
  if Line<FromPosY then exit;
 
262
  if Action=etscaInsert then begin
 
263
    // insert
 
264
    if Line>FromPosY then begin
 
265
      // insert in lines in front => move vertically
 
266
      inc(Line,ToPosY-FromPosY);
 
267
    end else begin
 
268
      // insert in same line
 
269
      if LeftBound then begin
 
270
        if Col<=FromPosX then exit;
 
271
      end else begin
 
272
        if Col<FromPosX then exit;
 
273
      end;
 
274
      if FromPosY<ToPosY then begin
 
275
        // multi line insert
 
276
        inc(Line,ToPosY-FromPosY);
 
277
        Col:=ToPosX+Col-FromPosX;
 
278
      end else begin
 
279
        // inserting some characters
 
280
        inc(Col,ToPosX-FromPosX);
 
281
      end;
 
282
    end;
 
283
  end else begin
 
284
    // delete
 
285
    if Line>ToPosY then begin
 
286
      // delete some lines in front => move vertically
 
287
      dec(Line,ToPosY-FromPosY);
 
288
    end else if Line<ToPosY then begin
 
289
      if Line>FromPosY then begin
 
290
        // whole line of position was deleted => move to start of deletion
 
291
        Line:=FromPosY;
 
292
        Col:=FromPosX;
 
293
      end else begin
 
294
        // Line=FromPosY, Line<ToPosY
 
295
        if Col<=FromPosX then begin
 
296
          // delete is behind position => ignore
 
297
        end else begin
 
298
          // position was deleted => move to start of deletion
 
299
          Line:=FromPosY;
 
300
          Col:=FromPosX;
 
301
        end;
 
302
      end;
 
303
    end else begin
 
304
      // Line=ToPosY
 
305
      if Line>FromPosY then begin
 
306
        // multi line delete
 
307
        if Col<=ToPosX then begin
 
308
          // position was deleted => move to start of deletion
 
309
          Line:=FromPosY;
 
310
          Col:=FromPosX;
 
311
        end else begin
 
312
          // some characters at the start of the line were deleted
 
313
          Line:=FromPosY;
 
314
          dec(Col,ToPosX-1);
 
315
        end;
 
316
      end else begin
 
317
        // Line=FromPosY=ToPosY
 
318
        if Col<=FromPosX then begin
 
319
          // delete is behind position => ignore
 
320
        end else if Col<=ToPosX then begin
 
321
          // position was deleted => move to start of deletion
 
322
          Col:=FromPosX;
 
323
        end else begin
 
324
          // some characters in front were deleted
 
325
          dec(Col,ToPosX-FromPosX);
 
326
        end;
 
327
      end;
 
328
    end;
 
329
  end;
 
330
  //debugln(['AdaptCaret ',Line,',',Col]);
 
331
end;
 
332
 
 
333
function CompareETSrcChangesFilenames(Changes1, Changes2: Pointer): integer;
 
334
var
 
335
  SrcChanges1: TETSrcChanges absolute Changes1;
 
336
  SrcChanges2: TETSrcChanges absolute Changes2;
 
337
begin
 
338
  Result:=CompareFilenames(SrcChanges1.Filename,SrcChanges2.Filename);
 
339
end;
 
340
 
 
341
function CompareFilenameAndETSrcChanges(aFilenameStr, Changes: Pointer
 
342
  ): integer;
 
343
var
 
344
  SrcChanges: TETSrcChanges absolute Changes;
 
345
begin
 
346
  Result:=CompareFilenames(AnsiString(aFilenameStr),SrcChanges.Filename);
 
347
end;
 
348
 
 
349
function dbgs(Action: TETSrcChangeAction): string;
 
350
begin
 
351
  Result:='';
 
352
  WriteStr(Result,Action);
 
353
end;
 
354
 
 
355
procedure Test_AdaptCaret;
 
356
 
 
357
  procedure T(Title: string; Line,Col: integer;
 
358
    LeftBound: boolean; // true = position is bound to character on the left
 
359
    Action: TETSrcChangeAction;
 
360
    FromPosY, FromPosX, ToPosY, ToPosX: integer;
 
361
    ExpectedLine, ExpectedCol: integer);
 
362
  var
 
363
    Y: Integer;
 
364
    X: Integer;
 
365
    s: String;
 
366
  begin
 
367
    Y:=Line;
 
368
    X:=Col;
 
369
    AdaptCaret(Y,X,LeftBound,Action,FromPosY,FromPosX,ToPosY,ToPosX);
 
370
    if (Y=ExpectedLine) and (X=ExpectedCol) then exit;
 
371
    s:='Test_AdaptCaret: Caret='+dbgs(Line)+','+dbgs(Col)
 
372
     +' LeftBound='+dbgs(LeftBound)
 
373
     +' Action='+dbgs(Action)
 
374
     +' FromPos='+dbgs(FromPosY)+','+dbgs(FromPosX)
 
375
     +' ToPos='+dbgs(ToPosY)+','+dbgs(ToPosX)
 
376
     +' Expected='+dbgs(ExpectedLine)+','+dbgs(ExpectedCol)
 
377
     +' Actual='+dbgs(Y)+','+dbgs(X);
 
378
    raise Exception.Create(Title+': '+s);
 
379
  end;
 
380
 
 
381
begin
 
382
  T('Insert chars in front',10,10,true,etscaInsert,1,1, 1,2,  10,10);
 
383
  T('Insert lines in front',10,10,true,etscaInsert,1,1, 2,2,  11,10);
 
384
  T('Insert chars behind',10,10,true,etscaInsert,12,1, 12,2,  10,10);
 
385
  T('Insert chars in front, same line',10,10,true,etscaInsert,10,1, 10,2,  10,11);
 
386
  T('Insert chars in front, same line',10,40,true,etscaInsert,10,28, 10,29,  10,41);
 
387
  T('Insert chars behind, same line',10,10,true,etscaInsert,10,11, 10,12,  10,10);
 
388
  T('Insert chars behind, same line, leftbound',10,10,true,etscaInsert,10,10, 10,12,  10,10);
 
389
  T('Insert chars behind, same line, rightbound',10,10,false,etscaInsert,10,10, 10,12,  10,12);
 
390
  T('Insert chars and line breaks in front, same line',10,10,true,etscaInsert,10,1, 11,1,  11,10);
 
391
  T('Insert chars and line breaks in front, same line',10,10,true,etscaInsert,10,1, 11,2,  11,11);
 
392
  T('Insert chars and line breaks in front, same line',10,10,true,etscaInsert,10,2, 11,2,  11,10);
 
393
  T('Insert chars and line breaks in front, same line',10,10,true,etscaInsert,10,2, 11,5,  11,13);
 
394
  T('Insert chars and line breaks in front, same line',10,10,true,etscaInsert,10,2, 13,5,  13,13);
 
395
 
 
396
  T('Delete chars in front',10,10,true,etscaDelete, 1,1, 1,2, 10,10);
 
397
  T('Delete lines in front',10,10,true,etscaDelete, 1,1, 2,2, 9,10);
 
398
  T('Delete chars in front, same line',10,10,true,etscaDelete, 10,1, 10,2, 10,9);
 
399
  T('Delete lines behind',10,10,true,etscaDelete, 11,1, 12,2, 10,10);
 
400
  T('Delete chars behind, same line',10,10,true,etscaDelete, 10,11, 10,12, 10,10);
 
401
  T('Delete chars behind, same line',10,10,true,etscaDelete, 10,10, 10,12, 10,10);
 
402
  T('Delete lines in front, same line',10,10,true,etscaDelete, 9,1, 10,1, 9,10);
 
403
  T('Delete lines in front, same line',10,10,true,etscaDelete, 9,1, 10,3, 9,8);
 
404
  T('Delete position',10,10,true,etscaDelete, 9,1, 11,1, 9,1);
 
405
  T('Delete position',10,10,true,etscaDelete, 10,1, 11,1, 10,1);
 
406
  T('Delete position',10,10,true,etscaDelete, 10,5, 10,11, 10,5);
 
407
end;
 
408
 
 
409
procedure Test_MergeTETSrcChanges;
 
410
var
 
411
  Changes: TETSrcChanges;
 
412
 
 
413
  procedure Check(Title: string; aChanges: array of TETSrcChange);
 
414
 
 
415
    procedure E(Msg: string);
 
416
    var
 
417
      s: String;
 
418
    begin
 
419
      s:=Title+', '+Msg;
 
420
      Changes.WriteDebugReport(s);
 
421
      raise Exception.Create(s);
 
422
    end;
 
423
 
 
424
  var
 
425
    i: Integer;
 
426
    ActualChange: TETSrcChange;
 
427
    ExpectedChange: TETSrcChange;
 
428
  begin
 
429
    ActualChange:=Changes.First;
 
430
    try
 
431
      for i:=Low(aChanges) to High(aChanges) do begin
 
432
        ExpectedChange:=aChanges[i];
 
433
        if ExpectedChange=nil then begin
 
434
          if ActualChange<>nil then
 
435
            E('too many changes');
 
436
          exit;
 
437
        end;
 
438
        if ActualChange=nil then
 
439
          E('not enough changes (missing: '+ActualChange.AsString+')');
 
440
        if ExpectedChange.AsString<>ActualChange.AsString then
 
441
          E('diff: Expected=('+ExpectedChange.AsString+'), Actual=('+ActualChange.AsString+')');
 
442
        ActualChange:=ActualChange.Next;
 
443
      end;
 
444
    finally
 
445
      for i:=Low(aChanges) to High(aChanges) do
 
446
        aChanges[i].Free;
 
447
    end;
 
448
  end;
 
449
 
 
450
begin
 
451
  Changes:=TETSrcChanges.Create;
 
452
  try
 
453
    Changes.ConsistencyCheck;
 
454
 
 
455
    // test empty clear
 
456
    Changes.Clear;
 
457
    Changes.ConsistencyCheck;
 
458
 
 
459
    // test merge insert
 
460
    Changes.Add(etscaInsert,1,1,1,46);
 
461
    Changes.ConsistencyCheck;
 
462
    Changes.Add(etscaInsert,1,46,2,1);
 
463
    Changes.ConsistencyCheck;
 
464
    Check('Merge insert',[TETSrcChange.Create(etscaInsert,1,1,2,1)]);
 
465
    Changes.Clear;
 
466
 
 
467
    // insert characters into a previous multi line insert
 
468
    Changes.Add(etscaInsert,10,1,12,1);
 
469
    Changes.ConsistencyCheck;
 
470
    Changes.Add(etscaInsert,10,1,10,2);
 
471
    Changes.ConsistencyCheck;
 
472
    Check('Ignore small insert',[TETSrcChange.Create(etscaInsert,10,1,12,1)]);
 
473
    Changes.Clear;
 
474
 
 
475
    // delete behind previous delete
 
476
    Changes.Add(etscaDelete,1,2,1,4);
 
477
    Changes.ConsistencyCheck;
 
478
    Changes.Add(etscaDelete,1,2,1,5);
 
479
    Changes.ConsistencyCheck;
 
480
    Check('combine deleting characters',[TETSrcChange.Create(etscaDelete,1,2,1,7)]);
 
481
    Changes.Clear;
 
482
 
 
483
    // delete encloses a previous delete
 
484
    Changes.Add(etscaDelete,1,2,1,4);
 
485
    Changes.ConsistencyCheck;
 
486
    Changes.Add(etscaDelete,1,1,1,5);
 
487
    Changes.ConsistencyCheck;
 
488
    Check('combine deleting characters',[TETSrcChange.Create(etscaDelete,1,1,1,7)]);
 
489
    Changes.Clear;
 
490
 
 
491
    // delete in front of a previous delete
 
492
    Changes.Add(etscaDelete,2,2,2,4);
 
493
    Changes.ConsistencyCheck;
 
494
    Changes.Add(etscaDelete,1,1,2,2);
 
495
    Changes.ConsistencyCheck;
 
496
    Check('combine deleting characters',[TETSrcChange.Create(etscaDelete,1,1,2,4)]);
 
497
    Changes.Clear;
 
498
 
 
499
    // delete encloses a previous delete of characters
 
500
    Changes.Add(etscaDelete,2,2,2,4);
 
501
    Changes.ConsistencyCheck;
 
502
    Changes.Add(etscaDelete,1,1,3,1);
 
503
    Changes.ConsistencyCheck;
 
504
    Check('combine deleting characters',[TETSrcChange.Create(etscaDelete,1,1,3,1)]);
 
505
    Changes.Clear;
 
506
 
 
507
    // delete encloses a previous delete of a line
 
508
    Changes.Add(etscaDelete,2,2,3,4);
 
509
    Changes.ConsistencyCheck;
 
510
    Changes.Add(etscaDelete,1,1,4,1);
 
511
    Changes.ConsistencyCheck;
 
512
    Check('combine deleting characters',[TETSrcChange.Create(etscaDelete,1,1,5,1)]);
 
513
    Changes.Clear;
 
514
 
 
515
    // delete encloses a previous delete at end
 
516
    Changes.Add(etscaDelete,2,2,3,1);
 
517
    Changes.ConsistencyCheck;
 
518
    Changes.Add(etscaDelete,1,1,2,3);
 
519
    Changes.ConsistencyCheck;
 
520
    Check('combine deleting characters',[TETSrcChange.Create(etscaDelete,1,1,3,2)]);
 
521
    Changes.Clear;
 
522
 
 
523
    // delete encloses a previous delete at end
 
524
    Changes.Add(etscaDelete,2,2,3,2);
 
525
    Changes.ConsistencyCheck;
 
526
    Changes.Add(etscaDelete,1,1,2,3);
 
527
    Changes.ConsistencyCheck;
 
528
    Check('combine deleting characters',[TETSrcChange.Create(etscaDelete,1,1,3,3)]);
 
529
    Changes.Clear;
 
530
 
 
531
    // delete encloses a previous delete at start
 
532
    Changes.Add(etscaDelete,1,2,3,2);
 
533
    Changes.ConsistencyCheck;
 
534
    Changes.Add(etscaDelete,1,1,1,2);
 
535
    Changes.ConsistencyCheck;
 
536
    Check('combine deleting characters',[TETSrcChange.Create(etscaDelete,1,1,3,2)]);
 
537
    Changes.Clear;
 
538
  finally
 
539
    Changes.Free;
 
540
  end;
 
541
end;
 
542
 
 
543
{ TETMultiSrcChanges }
 
544
 
 
545
constructor TETMultiSrcChanges.Create;
 
546
begin
 
547
  fAllChanges:=TAvgLvlTree.Create(@CompareETSrcChangesFilenames);
 
548
end;
 
549
 
 
550
destructor TETMultiSrcChanges.Destroy;
 
551
begin
 
552
  Clear;
 
553
  FreeAndNil(fAllChanges);
 
554
  inherited Destroy;
 
555
end;
 
556
 
 
557
// inline
 
558
function TETMultiSrcChanges.Count: integer;
 
559
begin
 
560
  Result:=fAllChanges.Count;
 
561
end;
 
562
 
 
563
procedure TETMultiSrcChanges.Clear;
 
564
begin
 
565
  fAllChanges.FreeAndClear;
 
566
end;
 
567
 
 
568
function TETMultiSrcChanges.GetChanges(const aFilename: string;
 
569
  CreateIfNotExists: boolean): TETSrcChanges;
 
570
var
 
571
  Node: TAvgLvlTreeNode;
 
572
begin
 
573
  Node:=fAllChanges.FindKey(Pointer(aFilename),@CompareFilenameAndETSrcChanges);
 
574
  if Node<>nil then
 
575
    Result:=TETSrcChanges(Node.Data)
 
576
  else if CreateIfNotExists then begin
 
577
    Result:=TETSrcChanges.Create;
 
578
    Result.Filename:=aFilename;
 
579
    fAllChanges.Add(Result);
 
580
  end else
 
581
    Result:=nil;
 
582
end;
 
583
 
 
584
function TETMultiSrcChanges.AdaptCaret(const aFilename: string; var Line,
 
585
  Col: integer; LeftBound: boolean): boolean;
 
586
var
 
587
  Changes: TETSrcChanges;
 
588
begin
 
589
  Changes:=GetChanges(aFilename,false);
 
590
  if Changes=nil then
 
591
    Result:=false
 
592
  else
 
593
    Result:=Changes.AdaptCaret(Line,Col,LeftBound);
 
594
end;
 
595
 
 
596
{ TETSrcChange }
 
597
 
 
598
constructor TETSrcChange.Create(AnAction: TETSrcChangeAction; const aFromPos,
 
599
  aToPos: TPoint);
 
600
begin
 
601
  Action:=AnAction;
 
602
  FromPos:=aFromPos;
 
603
  ToPos:=aToPos;
 
604
end;
 
605
 
 
606
constructor TETSrcChange.Create(AnAction: TETSrcChangeAction; FromPosY,
 
607
  FromPosX, ToPosY, ToPosX: integer);
 
608
begin
 
609
  Action:=AnAction;
 
610
  FromPos.Y:=FromPosY;
 
611
  FromPos.X:=FromPosX;
 
612
  ToPos.Y:=ToPosY;
 
613
  ToPos.X:=ToPosX;
 
614
end;
 
615
 
 
616
function TETSrcChange.AsString: string;
 
617
begin
 
618
  if Action=etscaInsert then
 
619
    Result:='Insert'
 
620
  else
 
621
    Result:='Delete';
 
622
  Result+='-From='+IntToStr(FromPos.Y)+','+IntToStr(FromPos.X);
 
623
  Result+='-To='+IntToStr(ToPos.Y)+','+IntToStr(ToPos.X);
 
624
end;
 
625
 
 
626
{ TETSrcChanges }
 
627
 
 
628
procedure TETSrcChanges.Append(Change: TETSrcChange);
 
629
begin
 
630
  if First=nil then begin
 
631
    FFirst:=Change;
 
632
  end else begin
 
633
    FLast.Next:=Change;
 
634
    Change.Prev:=Last;
 
635
  end;
 
636
  fLast:=Change;
 
637
end;
 
638
 
 
639
procedure TETSrcChanges.Remove(Change: TETSrcChange);
 
640
begin
 
641
  if First=Change then
 
642
    FFirst:=Change.Next;
 
643
  if Last=Change then
 
644
    fLast:=Change.Prev;
 
645
  if Change.Prev<>nil then
 
646
    Change.Prev.Next:=Change.Next;
 
647
  if Change.Next<>nil then
 
648
    Change.Next.Prev:=Change.Prev;
 
649
  Change.Prev:=nil;
 
650
  Change.Next:=nil;
 
651
end;
 
652
 
 
653
procedure TETSrcChanges.SetFilename(AValue: string);
 
654
var
 
655
  HasChanged: Boolean;
 
656
begin
 
657
  if FFilename=AValue then Exit;
 
658
  HasChanged:=CompareFilenames(FFilename,AValue)<>0;
 
659
  FFilename:=AValue;
 
660
  if HasChanged then
 
661
    Clear;
 
662
end;
 
663
 
 
664
constructor TETSrcChanges.Create;
 
665
begin
 
666
end;
 
667
 
 
668
destructor TETSrcChanges.Destroy;
 
669
begin
 
670
  Clear;
 
671
  inherited Destroy;
 
672
end;
 
673
 
 
674
procedure TETSrcChanges.Clear;
 
675
var
 
676
  Item: TETSrcChange;
 
677
  CurItem: TETSrcChange;
 
678
begin
 
679
  Item:=First;
 
680
  while Item<>nil do begin
 
681
    CurItem:=Item;
 
682
    Item:=Item.Next;
 
683
    CurItem.Free;
 
684
  end;
 
685
  fFirst:=nil;
 
686
  FLast:=nil;
 
687
end;
 
688
 
 
689
procedure TETSrcChanges.GetRange(out MinY, MaxY, LineDiffBehindMaxY: integer);
 
690
// true if there are changes
 
691
// All changes were done between lines MinY and MaxY (inclusive).
 
692
// Lines behind MaxY are moved by LineDiffBehindMaxY.
 
693
// In other words:
 
694
//   if MinY<=Line<=MaxY then AdaptCaret(Line,Col,...)
 
695
//   else if Line>MaxY then inc(Line,LineDiffBehindMaxY);
 
696
var
 
697
  Change: TETSrcChange;
 
698
  y: Integer;
 
699
  x: Integer;
 
700
begin
 
701
  MinY:=High(Integer);
 
702
  MaxY:=0;
 
703
  LineDiffBehindMaxY:=0;
 
704
  Change:=First;
 
705
  if Change=nil then exit;
 
706
  while Change<>nil do begin
 
707
    MinY:=Min(MinY,Change.FromPos.Y);
 
708
    if Change.Action=etscaInsert then
 
709
      MaxY:=Max(MaxY,Change.FromPos.Y)
 
710
    else
 
711
      MaxY:=Max(MaxY,Change.ToPos.Y);
 
712
    Change:=Change.Next;
 
713
  end;
 
714
  y:=MaxY+1;
 
715
  x:=1;
 
716
  AdaptCaret(y,x,true);
 
717
  LineDiffBehindMaxY:=y-(MaxY+1);
 
718
end;
 
719
 
 
720
// inline
 
721
function TETSrcChanges.Add(Action: TETSrcChangeAction; const FromPos,
 
722
  ToPos: TPoint): TETSrcChange;
 
723
begin
 
724
  Result:=Add(Action,FromPos.Y,FromPos.X,ToPos.Y,ToPos.X);
 
725
end;
 
726
 
 
727
function TETSrcChanges.Add(Action: TETSrcChangeAction; FromPosY, FromPosX,
 
728
  ToPosY, ToPosX: integer): TETSrcChange;
 
729
 
 
730
  procedure RaiseFromBehindToPos;
 
731
  begin
 
732
    raise Exception.CreateFmt('TETSrcChanges.Add FromPos=%s,%s behind ToPos=%s,%s',[FromPosY,FromPosX,ToPosY,ToPosX]);
 
733
  end;
 
734
 
 
735
  function Merge(Prev, Cur: TETSrcChange): boolean;
 
736
  begin
 
737
    if (Prev=nil) or (Prev.Action<>Action) then
 
738
      exit(false);
 
739
    // check if addition can be merged
 
740
    if Action=etscaInsert then begin
 
741
      if (Prev.ToPos.Y=Cur.FromPos.Y) and (Prev.ToPos.X=Cur.FromPos.X) then begin
 
742
        // Cur is an insert exactly behind Prev insert -> append insert
 
743
        Prev.ToPos.Y:=Cur.ToPos.Y;
 
744
        Prev.ToPos.X:=Cur.ToPos.X;
 
745
        {$IFDEF VerboseETSrcChange}
 
746
        debugln(['TETSrcChanges.Add appending insert: ',Prev.AsString]);
 
747
        {$ENDIF}
 
748
        exit(true);
 
749
      end;
 
750
      if (Cur.FromPos.Y=Cur.ToPos.Y)
 
751
      and (Prev.FromPos.Y<=Cur.FromPos.Y) and (Prev.ToPos.Y>Cur.FromPos.Y) then begin
 
752
        // Cur inserts characters into a Prev multi line insert -> ignore
 
753
        {$IFDEF VerboseETSrcChange}
 
754
        debugln(['TETSrcChanges.Add inserting characters into a multi line insert -> ignore']);
 
755
        {$ENDIF}
 
756
        exit(true);
 
757
      end;
 
758
      // ToDo: insert exactly in front
 
759
    end else begin
 
760
      if IsCaretInFrontOrSame(Cur.FromPos,Prev.FromPos)
 
761
      and IsCaretInFrontOrSame(Prev.FromPos,Cur.ToPos) then begin
 
762
        // Cur delete extends Prev delete => combine delete
 
763
        etSrcEditMarks.AdaptCaret(Cur.ToPos.Y,Cur.ToPos.X,false,etscaInsert,
 
764
          Prev.FromPos.Y,Prev.FromPos.X,Prev.ToPos.Y,Prev.ToPos.X);
 
765
        Prev.ToPos:=Cur.ToPos;
 
766
        Prev.FromPos:=Cur.FromPos;
 
767
        {$IFDEF VerboseETSrcChange}
 
768
        debugln(['TETSrcChanges.Add delete encloses previous delete: ',Prev.AsString]);
 
769
        {$ENDIF}
 
770
        exit(true);
 
771
      end;
 
772
    end;
 
773
    Result:=false;
 
774
  end;
 
775
 
 
776
begin
 
777
  {$IFDEF VerboseETSrcChange}
 
778
  debugln(['TETSrcChanges.Add Action=',dbgs(Action),' From=',FromPosY,',',FromPosX,' To=',ToPosY,',',ToPosX]);
 
779
  {$ENDIF}
 
780
 
 
781
  if (FromPosY=ToPosY) and (FromPosX=ToPosX) then
 
782
    exit; // no change => ignore
 
783
 
 
784
  // consistency check
 
785
  if IsCaretInFront(ToPosY,ToPosX,FromPosY,FromPosX) then
 
786
    RaiseFromBehindToPos;
 
787
 
 
788
  Result:=TETSrcChange.Create(Action, FromPosY, FromPosX, ToPosY, ToPosX);
 
789
 
 
790
  if Merge(Last,Result) then begin
 
791
    repeat
 
792
      Result.Free;
 
793
      Result:=Last;
 
794
      if not Merge(Result.Prev,Result) then exit;
 
795
      Remove(Last);
 
796
    until false;
 
797
  end else begin
 
798
    Append(Result);
 
799
  end;
 
800
end;
 
801
 
 
802
function TETSrcChanges.AdaptCaret(var Line, Col: integer; LeftBound: boolean
 
803
  ): boolean;
 
804
var
 
805
  Change: TETSrcChange;
 
806
  OldCol: Integer;
 
807
  OldLine: Integer;
 
808
begin
 
809
  OldCol:=Col;
 
810
  OldLine:=Line;
 
811
  Change:=First;
 
812
  while Change<>nil do begin
 
813
    etSrcEditMarks.AdaptCaret(Line,Col,LeftBound,Change.Action,
 
814
      Change.FromPos.Y,Change.FromPos.X,Change.ToPos.Y,Change.ToPos.X);
 
815
    Change:=Change.Next;
 
816
  end;
 
817
  Result:=(Line<>OldLine) or (Col<>OldCol);
 
818
end;
 
819
 
 
820
procedure TETSrcChanges.ConsistencyCheck;
 
821
 
 
822
  procedure E(Msg: string);
 
823
  begin
 
824
    raise Exception.Create('TETSrcChanges ConsistencyError: '+Msg);
 
825
  end;
 
826
 
 
827
var
 
828
  Change: TETSrcChange;
 
829
  List: TFPList;
 
830
begin
 
831
  if (First=nil)<>(Last=nil) then
 
832
    E('(First=nil)<>(Last=nil)');
 
833
  List:=TFPList.Create;
 
834
  try
 
835
    Change:=First;
 
836
    while Change<>nil do begin
 
837
      if IsCaretInFront(Change.ToPos,Change.FromPos) then
 
838
        E('FromPos>ToPos: '+Change.AsString);
 
839
      if Change.Prev<>nil then begin
 
840
        if Change.Prev.Next<>Change then
 
841
          E('Change.Prev.Next<>Change '+Change.AsString);
 
842
      end else begin
 
843
        if Change<>First then
 
844
          E('Change.Prev=nil');
 
845
      end;
 
846
      if (Change.Next=nil) and (Change<>Last) then
 
847
        E('Change.Next=nil');
 
848
      if List.IndexOf(Change)>=0 then
 
849
        E('Cycle '+Change.AsString);
 
850
      List.Add(Change);
 
851
      Change:=Change.Next;
 
852
    end;
 
853
  finally
 
854
    List.Free;
 
855
  end;
 
856
end;
 
857
 
 
858
procedure TETSrcChanges.WriteDebugReport(Title: string);
 
859
var
 
860
  Change: TETSrcChange;
 
861
begin
 
862
  debugln('TETSrcChanges.WriteDebugReport ',Title);
 
863
  Change:=First;
 
864
  while Change<>nil do begin
 
865
    debugln('  ',Change.AsString);
 
866
    Change:=Change.Next;
 
867
  end;
 
868
end;
 
869
 
 
870
{ TETSynPlugin }
 
871
 
 
872
procedure TETSynPlugin.DoSync(Data: PtrInt);
 
873
begin
 
874
  FSyncQueued:=false;
 
875
  if FChanges.First=nil then exit;
 
876
  if Assigned(OnChanged) then
 
877
    OnChanged(Self);
 
878
  FChanges.Clear;
 
879
end;
 
880
 
 
881
procedure TETSynPlugin.SetSyncQueued(AValue: boolean);
 
882
begin
 
883
  if FSyncQueued=AValue then Exit;
 
884
  FSyncQueued:=AValue;
 
885
  if SyncQueued then
 
886
    Application.QueueAsyncCall(@DoSync,0)
 
887
  else
 
888
    Application.RemoveAsyncCalls(Self);
 
889
end;
 
890
 
 
891
procedure TETSynPlugin.OnLineEdit(Sender: TSynEditStrings; aLinePos, aBytePos,
 
892
  aCount, aLineBrkCnt: Integer; aText: String);
 
893
{
 
894
  aLinePos is 1-based
 
895
  aBytePos is 1-based column in line
 
896
 
 
897
  Insert:
 
898
    aCount > 0
 
899
  Delete:
 
900
    aCount < 0
 
901
    Example deleting line 290..292:
 
902
      LinePos=291 BytePos=1 Count=-45 LineBrkCnt=0 Text=""
 
903
      LinePos=292 BytePos=1 Count=-33 LineBrkCnt=0 Text=""
 
904
      LinePos=291 BytePos=1 Count=0 LineBrkCnt=-2 Text=""
 
905
      LinePos=290 BytePos=70 Count=0 LineBrkCnt=-1 Text=""
 
906
      LinePos=290 BytePos=1 Count=-69 LineBrkCnt=0 Text=""
 
907
}
 
908
begin
 
909
  {$IFDEF VerboseETSrcChange}
 
910
  debugln(['TETSynPlugin.OnLineEdit LinePos=',aLinePos,' BytePos=',aBytePos,' Count=',aCount,' LineBrkCnt=',aLineBrkCnt,' Text="',dbgstr(aText),'"']);
 
911
  {$ENDIF}
 
912
  if aCount>0 then begin
 
913
    // insert characters
 
914
    FChanges.Add(etscaInsert,aLinePos,aBytePos,aLinePos,aBytePos+aCount);
 
915
  end else if aCount<0 then begin
 
916
    // delete characters
 
917
    FChanges.Add(etscaDelete,aLinePos,aBytePos,aLinePos,aBytePos-aCount);
 
918
  end else if aLineBrkCnt>0 then begin
 
919
    // insert line breaks
 
920
    // Note: always at end of line, because Count=0
 
921
    FChanges.Add(etscaInsert,aLinePos,aBytePos,aLinePos+aLineBrkCnt,1);
 
922
  end else if aLineBrkCnt<0 then begin
 
923
    // delete line breaks / empty lines
 
924
    FChanges.Add(etscaDelete,aLinePos,aBytePos,aLinePos-aLineBrkCnt,1);
 
925
  end else
 
926
    exit;
 
927
  SyncQueued:=true;
 
928
end;
 
929
 
 
930
constructor TETSynPlugin.Create(AOwner: TComponent);
 
931
begin
 
932
  inherited Create(AOwner);
 
933
  FChanges:=TETSrcChanges.Create;
 
934
  ViewedTextBuffer.AddEditHandler(@OnLineEdit);
 
935
end;
 
936
 
 
937
destructor TETSynPlugin.Destroy;
 
938
begin
 
939
  SyncQueued:=false;
 
940
  ViewedTextBuffer.RemoveEditHandler(@OnLineEdit);
 
941
  inherited Destroy;
 
942
  FreeAndNil(FChanges);
 
943
end;
 
944
 
 
945
{ TETMark }
 
946
 
 
947
destructor TETMark.Destroy;
 
948
begin
 
949
  if MsgLine is TLMsgViewLine then
 
950
    TLMsgViewLine(MsgLine).Mark:=nil;
 
951
  MsgLine:=nil;
 
952
  inherited Destroy;
 
953
end;
 
954
 
 
955
{ TETMarks }
 
956
 
 
957
function TETMarks.GetMarkStyles(Urgency: TMessageLineUrgency): TETMarkStyle;
 
958
begin
 
959
  Result:=fMarkStyles[Urgency];
 
960
end;
 
961
 
 
962
constructor TETMarks.Create(AOwner: TComponent);
 
963
var
 
964
  u: TMessageLineUrgency;
 
965
begin
 
966
  inherited Create(AOwner);
 
967
  for u:=low(TMessageLineUrgency) to high(TMessageLineUrgency) do
 
968
    fMarkStyles[u]:=TETMarkStyle.Create(u,clNone);
 
969
  fMarkStyles[mluHint].Color:=clGreen;
 
970
  fMarkStyles[mluNote].Color:=clGreen;
 
971
  fMarkStyles[mluWarning].Color:=clYellow;
 
972
  fMarkStyles[mluError].Color:=clRed;
 
973
  fMarkStyles[mluFatal].Color:=clRed;
 
974
  fMarkStyles[mluPanic].Color:=clRed;
 
975
end;
 
976
 
 
977
destructor TETMarks.Destroy;
 
978
var
 
979
  u: TMessageLineUrgency;
 
980
begin
 
981
  for u:=low(TMessageLineUrgency) to high(TMessageLineUrgency) do
 
982
    FreeAndNil(fMarkStyles[u]);
 
983
  inherited Destroy;
 
984
end;
 
985
 
 
986
function TETMarks.CreateMark(MsgLine: TMessageLine; aSynEdit: TSynEdit
 
987
  ): TETMark;
 
988
begin
 
989
  Result:=nil;
 
990
  if (MsgLine.Line<1) or (MsgLine.Column<1) or (MsgLine.Filename='') then exit;
 
991
  if aSynEdit=nil then begin
 
992
    if OnGetSynEditOfFile=nil then exit;
 
993
    OnGetSynEditOfFile(Self,MsgLine.Filename,aSynEdit);
 
994
    if (aSynEdit=nil) then exit;
 
995
  end;
 
996
  Result:=TETMark.Create(aSynEdit);
 
997
  Result.SourceMarks:=Self;
 
998
  Result.MsgLine:=MsgLine;
 
999
  Result.Line:=MsgLine.Line;
 
1000
  Result.Column:=MsgLine.Column;
 
1001
  Result.Visible:=true;
 
1002
  Result.Priority:=Priority;
 
1003
  Result.Urgency:=MsgLine.Urgency;
 
1004
  Result.ImageList:=ImageList;
 
1005
  Result.ImageIndex:=MarkStyles[Result.Urgency].ImageIndex;
 
1006
  Result.SourceMarkup:=MarkStyles[Result.Urgency].SourceMarkup;
 
1007
  aSynEdit.Marks.Add(Result);
 
1008
end;
 
1009
 
 
1010
procedure TETMarks.RemoveMarks(aSynEdit: TSynEdit);
 
1011
var
 
1012
  i: Integer;
 
1013
  Mark: TSynEditMark;
 
1014
begin
 
1015
  for i:=aSynEdit.Marks.Count-1 downto 0 do begin
 
1016
    Mark:=aSynEdit.Marks[i];
 
1017
    if Mark is TETMark then
 
1018
      Mark.Free;
 
1019
  end;
 
1020
end;
 
1021
 
 
1022
{ TETMarkStyle }
 
1023
 
 
1024
procedure TETMarkStyle.SetColor(AValue: TColor);
 
1025
begin
 
1026
  if FColor=AValue then Exit;
 
1027
  FColor:=AValue;
 
1028
  SourceMarkup.FrameColor:=Color;
 
1029
end;
 
1030
 
 
1031
constructor TETMarkStyle.Create(TheUrgency: TMessageLineUrgency;
 
1032
  TheColor: TColor);
 
1033
begin
 
1034
  FUrgency:=TheUrgency;
 
1035
  FColor:=TheColor;
 
1036
  FSourceMarkup:=TSynSelectedColor.Create;
 
1037
  SourceMarkup.Foreground:=clNone;
 
1038
  SourceMarkup.Background:=clNone;
 
1039
  SourceMarkup.FrameStyle:=slsWaved;
 
1040
  SourceMarkup.FrameEdges:=sfeBottom;
 
1041
  SourceMarkup.FrameColor:=Color;
 
1042
end;
 
1043
 
 
1044
destructor TETMarkStyle.Destroy;
 
1045
begin
 
1046
  FreeAndNil(FSourceMarkup);
 
1047
  inherited Destroy;
 
1048
end;
 
1049
 
 
1050
{ TExtToolSynGutterMarkProvider }
 
1051
 
 
1052
procedure TExtToolSynGutterMarkProvider.AdjustColorForMark(AMark: TSynEditMark;
 
1053
  var AColor: TColor; var APriority: Integer);
 
1054
var
 
1055
  ETMark: TETMark;
 
1056
begin
 
1057
  //DebugLn(['TExtToolSynGutterMarkProvider.AdjustColorForMark Line=',AMark.Line,' Color=',AMark.Column]);
 
1058
  if (AMark is TETMark) then begin
 
1059
    ETMark:=TETMark(AMark);
 
1060
    AColor:=ETMark.SourceMarks.MarkStyles[ETMark.Urgency].Color;
 
1061
  end else
 
1062
    inherited AdjustColorForMark(AMark, AColor, APriority);
 
1063
end;
 
1064
 
 
1065
{ TLMsgViewLine }
 
1066
 
 
1067
destructor TLMsgViewLine.Destroy;
 
1068
begin
 
1069
  FreeAndNil(Mark);
 
1070
  inherited Destroy;
 
1071
end;
 
1072
 
 
1073
end.
 
1074