~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/synedit/synedittexttrimmer.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
28
28
 
29
29
uses
30
30
LCLProc,
31
 
  Classes, SysUtils, SynEditTextBase,
 
31
  Classes, SysUtils, LazSynEditText, SynEditTextBase, SynEditTypes, SynEditHighlighter,
32
32
  SynEditPointClasses, SynEditMiscProcs;
33
33
 
34
34
type
36
36
  TSynEditStringTrimmingType = (settLeaveLine, settEditLine, settMoveCaret,
37
37
                                settIgnoreAll);
38
38
 
 
39
  TSynEditStringTrimmingList = class;
 
40
 
 
41
  { TLazSynDisplayTrim }
 
42
 
 
43
  TLazSynDisplayTrim = class(TLazSynDisplayViewEx)
 
44
  private
 
45
    FTrimer: TSynEditStringTrimmingList;
 
46
    FTempLineStringForPChar: String;
 
47
    FAtLineStart: Boolean;
 
48
  public
 
49
    constructor Create(ATrimer: TSynEditStringTrimmingList);
 
50
    procedure FinishHighlighterTokens; override;
 
51
    procedure SetHighlighterTokensLine(ALine: TLineIdx; out ARealLine: TLineIdx); override;
 
52
    function  GetNextHighlighterToken(out ATokenInfo: TLazSynDisplayTokenInfo): Boolean; override;
 
53
  end;
 
54
 
39
55
  { TSynEditStringTrimmingList }
40
56
 
41
57
  TSynEditStringTrimmingList = class(TSynEditStringsLinked)
53
69
    FLineEdited: Boolean;
54
70
    FTempLineStringForPChar: String; // experimental; used by GetPChar;
55
71
    FViewChangeStamp: int64;
 
72
    FDisplayView: TLazSynDisplayTrim;
56
73
    procedure DoCaretChanged(Sender : TObject);
57
74
    procedure ListCleared(Sender: TObject);
58
75
    Procedure LinesChanged(Sender: TSynEditStrings; AIndex, ACount : Integer);
79
96
    procedure Put(Index: integer; const S: string); override;
80
97
    procedure PutObject(Index: integer; AObject: TObject); override;
81
98
    function  GetPCharSpaces(ALineIndex: Integer; out ALen: Integer): PChar; // experimental
 
99
    function GetDisplayView: TLazSynDisplayView; override;
82
100
  public
83
101
    constructor Create(ASynStringSource: TSynEditStrings; ACaret: TSynEditCaret);
84
102
    destructor Destroy; override;
118
136
 
119
137
{off $Define SynTrimUndoDebug}
120
138
{off $Define SynTrimDebug}
121
 
{$IFDEF SynUndoDebug}{$Define SynTrimUndoDebug}{$ENDIF}
 
139
{$IFDEF SynUndoDebug}
 
140
  {$Define SynUndoDebugItems}
 
141
  {$Define SynTrimUndoDebug}
 
142
{$ENDIF}
122
143
 
123
144
type
124
145
 
184
205
    function PerformUndo(Caller: TObject): Boolean; override;
185
206
  end;
186
207
 
 
208
{ TLazSynDisplayTrim }
 
209
 
 
210
constructor TLazSynDisplayTrim.Create(ATrimer: TSynEditStringTrimmingList);
 
211
begin
 
212
  inherited Create;
 
213
  FTrimer := ATrimer;
 
214
end;
 
215
 
 
216
procedure TLazSynDisplayTrim.FinishHighlighterTokens;
 
217
begin
 
218
  inherited FinishHighlighterTokens;
 
219
  FTempLineStringForPChar := '';
 
220
end;
 
221
 
 
222
procedure TLazSynDisplayTrim.SetHighlighterTokensLine(ALine: TLineIdx; out ARealLine: TLineIdx);
 
223
begin
 
224
  CurrentTokenLine := ALine;
 
225
  FAtLineStart := True;
 
226
  inherited SetHighlighterTokensLine(ALine, ARealLine);
 
227
end;
 
228
 
 
229
function TLazSynDisplayTrim.GetNextHighlighterToken(out ATokenInfo: TLazSynDisplayTokenInfo): Boolean;
 
230
begin
 
231
  Result := False;
 
232
  if not Initialized then exit;
 
233
 
 
234
  if (CurrentTokenHighlighter = nil) and (FTrimer.Spaces(CurrentTokenLine) <> '') then begin
 
235
    Result := FAtLineStart;
 
236
    if not Result then exit;
 
237
 
 
238
    FTempLineStringForPChar := FTrimer[CurrentTokenLine];
 
239
    ATokenInfo.TokenStart := PChar(FTempLineStringForPChar);
 
240
    ATokenInfo.TokenLength := length(FTempLineStringForPChar);
 
241
    ATokenInfo.TokenAttr := nil;
 
242
    FAtLineStart := False;
 
243
    exit;
 
244
  end;
 
245
 
 
246
  // highlighter currently includes trimed spaces
 
247
  Result := inherited GetNextHighlighterToken(ATokenInfo);
 
248
end;
 
249
 
187
250
{ TSynEditUndoTrimMoveTo }
188
251
 
189
252
function TSynEditUndoTrimMoveTo.DebugString: String;
195
258
begin
196
259
  FPosY := APosY;
197
260
  FLen :=  ALen;
198
 
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Insert ',DbgSName(self),dbgs(Self), ' - ', DebugString]);{$ENDIF}
 
261
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Insert ',DbgSName(self), ' ', dbgs(Self), ' - ', DebugString]);{$ENDIF}
199
262
end;
200
263
 
201
264
function TSynEditUndoTrimMoveTo.PerformUndo(Caller: TObject): Boolean;
202
265
begin
203
266
  Result := Caller is TSynEditStringTrimmingList;
204
267
  if Result then begin
205
 
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Perform ',DbgSName(self),dbgs(Self), ' - ', DebugString]);{$ENDIF}
 
268
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Perform ',DbgSName(self), ' ', dbgs(Self), ' - ', DebugString]);{$ENDIF}
206
269
    with TSynEditStringTrimmingList(Caller) do begin
207
270
      EditMoveFromTrim(FPosY, FLen);
208
271
      SendNotification(senrLineChange, TSynEditStringTrimmingList(Caller),
222
285
begin
223
286
  FPosY := APosY;
224
287
  FLen :=  ALen;
225
 
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Insert ',DbgSName(self),dbgs(Self), ' - ', DebugString]);{$ENDIF}
 
288
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Insert ',DbgSName(self), ' ', dbgs(Self), ' - ', DebugString]);{$ENDIF}
226
289
end;
227
290
 
228
291
function TSynEditUndoTrimMoveFrom.PerformUndo(Caller: TObject): Boolean;
229
292
begin
230
293
  Result := Caller is TSynEditStringTrimmingList;
231
294
  if Result then begin
232
 
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Perform ',DbgSName(self),dbgs(Self), ' - ', DebugString]);{$ENDIF}
 
295
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Perform ',DbgSName(self), ' ', dbgs(Self), ' - ', DebugString]);{$ENDIF}
233
296
    with TSynEditStringTrimmingList(Caller) do begin
234
297
      EditMoveToTrim(FPosY, FLen);
235
298
      SendNotification(senrLineChange, TSynEditStringTrimmingList(Caller),
250
313
  FPosX := APosX;
251
314
  FPosY := APosY;
252
315
  FLen :=  ALen;
253
 
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Insert ',DbgSName(self),dbgs(Self), ' - ', DebugString]);{$ENDIF}
 
316
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Insert ',DbgSName(self), ' ', dbgs(Self), ' - ', DebugString]);{$ENDIF}
254
317
end;
255
318
 
256
319
function TSynEditUndoTrimInsert.PerformUndo(Caller: TObject): Boolean;
257
320
begin
258
321
  Result := Caller is TSynEditStringTrimmingList;
259
322
  if Result then begin
260
 
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Perform ',DbgSName(self),dbgs(Self), ' - ', DebugString]);{$ENDIF}
 
323
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Perform ',DbgSName(self), ' ', dbgs(Self), ' - ', DebugString]);{$ENDIF}
261
324
    with TSynEditStringTrimmingList(Caller) do begin
262
325
      EditDeleteTrim(FPosX, FPosY, FLen);
263
326
      SendNotification(senrLineChange, TSynEditStringTrimmingList(Caller),
280
343
  FPosX := APosX;
281
344
  FPosY := APosY;
282
345
  FText :=  AText;
283
 
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Insert ',DbgSName(self),dbgs(Self), ' - ', DebugString]);{$ENDIF}
 
346
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Insert ',DbgSName(self), ' ', dbgs(Self), ' - ', DebugString]);{$ENDIF}
284
347
end;
285
348
 
286
349
function TSynEditUndoTrimDelete.PerformUndo(Caller: TObject): Boolean;
287
350
begin
288
351
  Result := Caller is TSynEditStringTrimmingList;
289
352
  if Result then begin
290
 
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Perform ',DbgSName(self),dbgs(Self), ' - ', DebugString]);{$ENDIF}
 
353
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Perform ',DbgSName(self), ' ', dbgs(Self), ' - ', DebugString]);{$ENDIF}
291
354
    with TSynEditStringTrimmingList(Caller) do begin
292
355
      EditInsertTrim(FPosX, FPosY, FText);
293
356
      SendNotification(senrLineChange, TSynEditStringTrimmingList(Caller),
309
372
begin
310
373
  FPosY := APosY;
311
374
  FText :=  AText;
312
 
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Insert ',DbgSName(self),dbgs(Self), ' - ', DebugString]);{$ENDIF}
 
375
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Insert ',DbgSName(self), ' ', dbgs(Self), ' - ', DebugString]);{$ENDIF}
313
376
end;
314
377
 
315
378
function TSynEditUndoTrimForget.PerformUndo(Caller: TObject): Boolean;
316
379
begin
317
380
  Result := Caller is TSynEditStringTrimmingList;
318
381
  if Result then begin
319
 
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Perform ',DbgSName(self),dbgs(Self), ' - ', DebugString]);{$ENDIF}
 
382
  {$IFDEF SynTrimUndoDebug}debugln(['--- Trimmer Undo Perform ',DbgSName(self), ' ', dbgs(Self), ' - ', DebugString]);{$ENDIF}
320
383
    with TSynEditStringTrimmingList(Caller) do begin
321
384
      CurUndoList.Lock;
322
385
      EditInsertTrim(1, FPosY, FText);
344
407
  fCaret := ACaret;
345
408
  fCaret.AddChangeHandler(@DoCaretChanged);
346
409
  fLockList := TStringList.Create;
 
410
  FDisplayView := TLazSynDisplayTrim.Create(Self);
 
411
  FDisplayView.NextView := ASynStringSource.DisplayView;
347
412
  fLineIndex:= -1;
348
413
  fSpaces := '';
349
414
  fEnabled:=false;
363
428
  fSynStrings.RemoveChangeHandler(senrLineChange, {$IFDEF FPC}@{$ENDIF}LinesChanged);
364
429
  fSynStrings.RemoveNotifyHandler(senrCleared, {$IFDEF FPC}@{$ENDIF}ListCleared);
365
430
  fCaret.RemoveChangeHandler(@DoCaretChanged);
 
431
  FreeAndNil(FDisplayView);
366
432
  FreeAndNil(fLockList);
367
433
  inherited Destroy;
368
434
end;
740
806
  Result := PChar(FTempLineStringForPChar);
741
807
end;
742
808
 
 
809
function TSynEditStringTrimmingList.GetDisplayView: TLazSynDisplayView;
 
810
begin
 
811
  Result := FDisplayView;
 
812
end;
 
813
 
743
814
function TSynEditStringTrimmingList.GetPChar(ALineIndex: Integer; out ALen: Integer): PChar;
744
815
begin
745
816
  Result := inherited GetPChar(ALineIndex, ALen);
861
932
    exit;
862
933
  end;
863
934
 
 
935
  IncIsInEditAction;
864
936
  if Count = 0 then fSynStrings.Add('');
865
937
  FlushNotificationCache;
866
938
  IgnoreSendNotification(senrEditAction, True);
911
983
  UpdateLineText(LogY);
912
984
  IgnoreSendNotification(senrEditAction, False);
913
985
  SendNotification(senrEditAction, self, LogY, 0, SaveLogX, length(SaveText), SaveText);
 
986
  DecIsInEditAction;
914
987
end;
915
988
 
916
989
Function TSynEditStringTrimmingList.EditDelete(LogX, LogY, ByteLen: Integer): String;
924
997
    exit;
925
998
  end;
926
999
 
 
1000
  IncIsInEditAction;
927
1001
  FlushNotificationCache;
928
1002
  SaveByteLen := ByteLen;
929
1003
  Result := '';
953
1027
 
954
1028
  IgnoreSendNotification(senrEditAction, False);
955
1029
  SendNotification(senrEditAction, self, LogY, 0, LogX, -SaveByteLen, '');
 
1030
  DecIsInEditAction;
956
1031
end;
957
1032
 
958
1033
procedure TSynEditStringTrimmingList.EditLineBreak(LogX, LogY: Integer);
964
1039
    exit;
965
1040
  end;
966
1041
 
 
1042
  IncIsInEditAction;
967
1043
  FlushNotificationCache;
968
1044
  IgnoreSendNotification(senrEditAction, True);
969
1045
  s := Spaces(LogY - 1);
988
1064
  EditMoveToTrim(LogY + 1, length(s) - LastNoneSpacePos(s));
989
1065
  IgnoreSendNotification(senrEditAction, False);
990
1066
  SendNotification(senrEditAction, self, LogY, 1, LogX, 0, '');
 
1067
  DecIsInEditAction;
991
1068
end;
992
1069
 
993
1070
procedure TSynEditStringTrimmingList.EditLineJoin(LogY: Integer;
1000
1077
    exit;
1001
1078
  end;
1002
1079
 
 
1080
  IncIsInEditAction;
1003
1081
  FlushNotificationCache;
1004
1082
  EditMoveFromTrim(LogY, length(Spaces(LogY - 1)));
1005
1083
 
1013
1091
  // Trim any existing (committed/real) spaces
1014
1092
  s := fSynStrings[LogY - 1];
1015
1093
  EditMoveToTrim(LogY, length(s) - LastNoneSpacePos(s));
 
1094
  DecIsInEditAction;
1016
1095
end;
1017
1096
 
1018
1097
procedure TSynEditStringTrimmingList.EditLinesInsert(LogY, ACount: Integer;
1020
1099
var
1021
1100
  s: string;
1022
1101
begin
 
1102
  IncIsInEditAction;
1023
1103
  FlushNotificationCache;
1024
1104
  fSynStrings.EditLinesInsert(LogY, ACount, AText);
1025
1105
  s := fSynStrings[LogY - 1];
1026
1106
  EditMoveToTrim(LogY, length(s) - LastNoneSpacePos(s));
 
1107
  DecIsInEditAction;
1027
1108
end;
1028
1109
 
1029
1110
procedure TSynEditStringTrimmingList.EditLinesDelete(LogY, ACount: Integer);
1030
1111
var
1031
1112
  i: Integer;
1032
1113
begin
 
1114
  IncIsInEditAction;
1033
1115
  FlushNotificationCache;
1034
1116
  for i := LogY to LogY + ACount - 1 do
1035
1117
    EditMoveFromTrim(i, length(Spaces(i - 1)));
1036
1118
  fSynStrings.EditLinesDelete(LogY, ACount);
 
1119
  DecIsInEditAction;
1037
1120
end;
1038
1121
 
1039
1122
procedure TSynEditStringTrimmingList.EditUndo(Item: TSynEditUndoItem);
1043
1126
 
1044
1127
procedure TSynEditStringTrimmingList.EditRedo(Item: TSynEditUndoItem);
1045
1128
begin
 
1129
  IncIsInEditAction; // all undo calls edit actions
1046
1130
  if not Item.PerformUndo(self) then
1047
1131
    inherited EditRedo(Item);
 
1132
  DecIsInEditAction;
1048
1133
end;
1049
1134
 
1050
1135
end.