← Back to branch summary

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

« back to all changes in this revision

Viewing changes to components/synedit/syneditkeycmds.pp

  • 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
http://bugs.debian.org/708695
[ 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:
components/synedit/syneditkeycmds.pp
27
27
If you do not delete the provisions above, a recipient may use your version
28
28
of this file under either the MPL or the GPL.
29
29
 
30
 
$Id: syneditkeycmds.pp 22581 2009-11-13 21:56:26Z martin $
 
30
$Id: syneditkeycmds.pp 36049 2012-03-15 22:59:28Z mattias $
31
31
 
32
32
You may retrieve the latest version of this file at the SynEdit home page,
33
33
located at http://SynEdit.SourceForge.net
88
88
  ecEditorBottom    = 16;   // Move cursor to absolute end
89
89
  ecGotoXY          = 17;   // Move cursor to specific coordinates, Data = PPoint
90
90
  ecLineTextStart   = 18;   // Move cursor to the first none whitespace in the line
 
91
  ecWordEndLeft     = 19;   // Move cursor left one word (to end of word)
 
92
  ecWordEndRight    = 20;   // Move cursor right one word (to end of word)
 
93
  ecHalfWordLeft    = 21;    // Move cursor left to word-begin/end or case change lower to uppper
 
94
  ecHalfWordRight   = 22;    // Move cursor right to word-begin/end or case change lower to uppper
91
95
 
92
96
//******************************************************************************
93
97
// Maybe the command processor should just take a boolean that signifies if
120
124
  ecSelEditorBottom = ecEditorBottom + ecSelection;
121
125
  ecSelGotoXY       = ecGotoXY + ecSelection;  // Data = PPoint
122
126
  ecSelLineTextStart= ecLineTextStart + ecSelection;   // Move cursor to the first none whitespace in the line
 
127
  ecSelWordEndLeft  = ecWordEndLeft + ecSelection;
 
128
  ecSelWordEndRight = ecWordEndRight + ecSelection;
 
129
  ecSelHalfWordLeft = ecHalfWordLeft + ecSelection;
 
130
  ecSelHalfWordRight= ecHalfWordRight + ecSelection;
123
131
 
124
132
  ecSelCmdRangeStart = ecLeft + ecSelection;
125
133
  ecSelCmdRangeEnd   = ecLeft + ecSelection + 49;
265
273
  ecGotFocus        = 700;
266
274
  ecLostFocus       = 701;
267
275
 
 
276
  ecUserDefinedFirst  = 900;
 
277
  ecUserDefinedLast   = 999;
 
278
 
268
279
  ecUserFirst       = 1001; // Start of user-defined commands
269
280
 
270
281
  ecPluginFirst = 20000;
274
285
// If ask by SynEdit they add an offset
275
286
 
276
287
// Return the next offset
277
 
function AllocatePluginKeyRange(Count: Integer): integer;
 
288
function AllocatePluginKeyRange(Count: Integer; OffsetOnly: Boolean = False): integer;
278
289
 
279
290
type
280
291
  ESynKeyError = class(Exception);
349
360
    function FindKeycode(Code: word; SS: TShiftState): integer;
350
361
    function FindKeycodeEx(Code: word; SS: TShiftState; var Data: pointer;
351
362
                           out IsStartOfCombo: boolean;
352
 
                           FinishComboOnly: Boolean = False): TSynEditorCommand;
 
363
                           FinishComboOnly: Boolean = False;
 
364
                           ComboStart: TSynEditKeyStrokes = nil): TSynEditorCommand;
353
365
    procedure ResetKeyCombo;
354
366
    function FindShortcut(SC: TShortcut): integer;
355
367
    function FindShortcut2(SC, SC2: TShortcut): integer;
365
377
    property UsePluginOffset: Boolean read FUsePluginOffset write FUsePluginOffset;
366
378
  end;
367
379
 
 
380
  TGetEditorCommandValuesProc = procedure(Proc: TGetStrProc);
 
381
 
368
382
// These are mainly for the TSynEditorCommand property editor, but could be
369
383
// useful elsewhere.
370
384
function EditorCommandToDescrString(Cmd: TSynEditorCommand): string;
374
388
function EditorCommandToIdent(Cmd: longint; var Ident: string): boolean;
375
389
 
376
390
procedure RegisterKeyCmdIdentProcs(IdentToIntFn: TIdentToInt; IntToIdentFn: TIntToIdent);
 
391
procedure RegisterExtraGetEditorCommandValues(AProc: TGetEditorCommandValuesProc);
377
392
 
378
393
implementation
379
394
 
481
496
{$ENDIF}
482
497
 
483
498
const
484
 
  EditorCommandStrs: array[0..141] of TIdentMapEntry = (
 
499
  EditorCommandStrs: array[0..149] of TIdentMapEntry = (
485
500
    (Value: ecNone; Name: 'ecNone'),
486
501
    (Value: ecLeft; Name: 'ecLeft'),
487
502
    (Value: ecRight; Name: 'ecRight'),
489
504
    (Value: ecDown; Name: 'ecDown'),
490
505
    (Value: ecWordLeft; Name: 'ecWordLeft'),
491
506
    (Value: ecWordRight; Name: 'ecWordRight'),
 
507
    (Value: ecWordEndLeft; Name: 'ecWordEndLeft'),
 
508
    (Value: ecWordEndRight; Name: 'ecWordEndRight'),
 
509
    (Value: ecHalfWordLeft; Name: 'ecHalfWordLeft'),
 
510
    (Value: ecHalfWordRight; Name: 'ecHalfWordRight'),
492
511
    (Value: ecLineStart; Name: 'ecLineStart'),
493
512
    (Value: ecLineEnd; Name: 'ecLineEnd'),
494
513
    (Value: ecPageUp; Name: 'ecPageUp'),
507
526
    (Value: ecSelDown; Name: 'ecSelDown'),
508
527
    (Value: ecSelWordLeft; Name: 'ecSelWordLeft'),
509
528
    (Value: ecSelWordRight; Name: 'ecSelWordRight'),
 
529
    (Value: ecSelWordEndLeft; Name: 'ecSelWordEndLeft'),
 
530
    (Value: ecSelWordEndRight; Name: 'ecSelWordEndRight'),
 
531
    (Value: ecSelHalfWordLeft; Name: 'ecSelHalfWordLeft'),
 
532
    (Value: ecSelHalfWordRight; Name: 'ecSelHalfWordRight'),
510
533
    (Value: ecSelLineStart; Name: 'ecSelLineStart'),
511
534
    (Value: ecSelLineEnd; Name: 'ecSelLineEnd'),
512
535
    (Value: ecSelPageUp; Name: 'ecSelPageUp'),
629
652
var
630
653
  ExtraIdentToIntFn: Array of TIdentToInt = nil;
631
654
  ExtraIntToIdentFn: Array of TIntToIdent = nil;
 
655
  ExtraGetEditorCommandValues: Array of TGetEditorCommandValuesProc = nil;
632
656
 
633
657
procedure GetEditorCommandValues(Proc: TGetStrProc);
634
658
var
635
659
  i: integer;
636
660
begin
 
661
  for i := 0 to 19 do
 
662
    Proc('ecUserDefined' + IntToStr(i));
637
663
  for i := Low(EditorCommandStrs) to High(EditorCommandStrs) do
638
664
    Proc(EditorCommandStrs[I].Name);
 
665
  i := 0;
 
666
  while (i < length(ExtraGetEditorCommandValues)) do begin
 
667
    ExtraGetEditorCommandValues[i](Proc);
 
668
    inc(i);
 
669
  end;
639
670
end;
640
671
 
641
672
function IdentToEditorCommand(const Ident: string; var Cmd: longint): boolean;
642
673
var
643
674
  i: Integer;
644
675
begin
 
676
  if (copy(Ident, 1 , 13) = 'ecUserDefined') then begin
 
677
    Cmd := StrToIntDef(copy(Ident, 14, length(Ident)), -1) + ecUserDefinedFirst;
 
678
    Result := (Cmd >= ecUserDefinedFirst) and (Cmd <= ecUserDefinedLast);
 
679
    if Result then
 
680
      exit;
 
681
  end;
645
682
  Result := IdentToInt(Ident, Cmd, EditorCommandStrs);
646
683
  i := 0;
647
684
  while (i < length(ExtraIdentToIntFn)) and (not Result) do begin
654
691
var
655
692
  i: Integer;
656
693
begin
 
694
  if (Cmd >= ecUserDefinedFirst) and (Cmd <= ecUserDefinedLast) then begin
 
695
    Ident := 'ecUserDefined' + IntToStr(Cmd - ecUserDefinedFirst);
 
696
    Result := True;
 
697
    exit;
 
698
  end;
657
699
  Result := IntToIdent(Cmd, Ident, EditorCommandStrs);
658
700
  i := 0;
659
701
  while (i < length(ExtraIntToIdentFn)) and (not Result) do begin
675
717
  ExtraIntToIdentFn[i] := IntToIdentFn;
676
718
end;
677
719
 
678
 
 
679
 
function AllocatePluginKeyRange(Count: Integer): integer;
 
720
procedure RegisterExtraGetEditorCommandValues(AProc: TGetEditorCommandValuesProc);
 
721
var
 
722
  i: Integer;
 
723
begin
 
724
  i := length(ExtraGetEditorCommandValues);
 
725
  SetLength(ExtraGetEditorCommandValues, i + 1);
 
726
  ExtraGetEditorCommandValues[i] := AProc;
 
727
end;
 
728
 
 
729
 
 
730
function AllocatePluginKeyRange(Count: Integer; OffsetOnly: Boolean): integer;
680
731
const
681
732
  CurOffset : integer = 0;
682
733
begin
683
734
  Result := CurOffset;
684
735
  inc(CurOffset, Count);
 
736
  if not OffsetOnly then
 
737
    inc(Result, ecPluginFirst);
685
738
end;
686
739
 
687
740
function EditorCommandToDescrString(Cmd: TSynEditorCommand): string;
905
958
    end;
906
959
end;
907
960
 
908
 
function TSynEditKeyStrokes.FindKeycodeEx(Code: word; SS: TShiftState; var Data: pointer; out
909
 
  IsStartOfCombo: boolean; FinishComboOnly: Boolean = False): TSynEditorCommand;
 
961
function TSynEditKeyStrokes.FindKeycodeEx(Code: word; SS: TShiftState; var Data: pointer;
 
962
  out IsStartOfCombo: boolean;
 
963
  FinishComboOnly: Boolean; ComboStart: TSynEditKeyStrokes): TSynEditorCommand;
910
964
var
911
965
  i: integer;
 
966
  CurComboStart: TSynEditKeyStrokes;
912
967
{$IFNDEF SYN_COMPILER_3_UP}
913
968
const
914
969
  VK_ACCEPT = $30;
915
970
{$ENDIF}
916
971
begin
917
 
  i := FindKeycode2(fLastKey, fLastShiftState, Code, SS);
918
 
  if (i < 0) and not FinishComboOnly then
919
 
    i := FindKeycode(Code, SS);
920
 
  if i >= 0 then
921
 
    Result := Items[i].Command
 
972
  (* if FinishComboOnly=True then ComboStart are the KeyStrokes, which have the
 
973
     already received keys.
 
974
     If several TSynEditKeyStrokes have combos, starting with the same key(s)
 
975
     only one needs to keep the info. The others chek, if they have a matching combo
 
976
  *)
 
977
 
 
978
  Result := ecNone;
 
979
  IsStartOfCombo := False;
 
980
 
 
981
  if ComboStart = nil then
 
982
    CurComboStart := self
922
983
  else
923
 
    Result := ecNone;
924
 
 
925
 
  if (Result = ecNone) and (Code >= VK_ACCEPT) and (Code <= VK_SCROLL) and
926
 
     (FindKeycode2Start(Code, SS) >= 0) and not FinishComboOnly then
 
984
    CurComboStart := ComboStart;
 
985
 
 
986
  if CurComboStart.fLastKey <> 0 then begin
 
987
    // Try to finish the combo
 
988
    i := FindKeycode2(CurComboStart.fLastKey, CurComboStart.fLastShiftState, Code, SS);
 
989
    if (i >= 0) then begin
 
990
      Result := Items[i].Command;
 
991
      CurComboStart.ResetKeyCombo;
 
992
      exit;
 
993
    end;
 
994
  end;
 
995
  if FinishComboOnly then
 
996
    exit;
 
997
 
 
998
  // Check for single stroke
 
999
  i := FindKeycode(Code, SS);
 
1000
  if i >= 0 then begin
 
1001
    Result := Items[i].Command;
 
1002
    ResetKeyCombo;
 
1003
    if (ComboStart <> nil) and (ComboStart <> self) then
 
1004
      ComboStart.ResetKeyCombo;
 
1005
    exit;
 
1006
  end;
 
1007
 
 
1008
  if (FindKeycode2Start(Code, SS) >= 0) and not FinishComboOnly then
927
1009
  begin
928
1010
    fLastKey := Code;
929
1011
    fLastShiftState := SS;
930
1012
    IsStartOfCombo := True;
931
 
  end else begin
932
 
    fLastKey := 0;
933
 
    fLastShiftState := [];
934
 
    IsStartOfCombo := False;
935
 
  end;
 
1013
    // Now this is the start of combo
 
1014
    if (ComboStart <> nil) and (ComboStart <> self) then
 
1015
      ComboStart.ResetKeyCombo;
 
1016
  end
 
1017
  else begin
 
1018
    // Nothing was found.
 
1019
    // Keep CurComboStart.fLastKey. It may be ued by another TSynEditKeyStrokes
 
1020
    if (ComboStart <> self) then
 
1021
      ResetKeyCombo; // reset self, if not CurComboStart
 
1022
  end
936
1023
end;
937
1024
 
938
1025
procedure TSynEditKeyStrokes.ResetKeyCombo;
1014
1101
var
1015
1102
  Num: integer;
1016
1103
begin
 
1104
  Num := 0;
1017
1105
  AStream.Read(Num, SizeOf(Num));
1018
1106
  while Num > 0 do begin
1019
1107
    with Add do