implemented proc jumping for operators

git-svn-id: trunk@4938 -

components/codetools/customcodetool.pas

@@ -1865,6 +1865,8 @@ begin
     ErrorPosition.Code:=TCodeBuffer(Scanner.MainCode);
     ErrorPosition.Y:=-1;
   end;
+  if AnsiCompareText(TheException.Message,'identifier expected, but keyword + found')=0 then
+    RaiseCatchableException(TheException.Message);
   // raise the exception
   CurrentPhase:=CodeToolPhaseNone;
   if not RaiseUnhandableExceptions then

components/codetools/finddeclarationtool.pas

@@ -2672,6 +2672,7 @@ begin
   // -> find class name
   MoveCursorToNodeStart(ProcContextNode.FirstChild);
   ReadNextAtom; // read name
+  if not AtomIsIdentifier(false) then exit; // ignore operator procs
   NameAtom:=CurPos;
   ReadNextAtom;
   if AtomIsChar('.') then begin
@@ -2679,8 +2680,8 @@ begin
     // -> proceed the search normally ...
   end else begin
     // proc is a proc declaration
-    if (fdfCollect in Params.Flags)
+    if ((fdfCollect in Params.Flags)
-    or CompareSrcIdentifiers(NameAtom.StartPos,Params.Identifier) then begin
+    or CompareSrcIdentifiers(NameAtom.StartPos,Params.Identifier)) then begin
       // proc identifier found
       {$IFDEF ShowTriedContexts}
       writeln('[TFindDeclarationTool.FindIdentifierInProcContext]  Proc-Identifier found="',GetIdentifier(Params.Identifier),'"');

components/codetools/methodjumptool.pas

@@ -275,18 +275,19 @@ const
   // if this fails
   // search for a proc node with same name and jump to difference in param list
   // returns true on jumped, false if no target proc found
-  var SearchedProcHead: string;
+  var
-    //FromProcHead, ToProcHead: string;
+    SearchedProcHead: string;
-    //Attr: TProcHeadAttributes;
-    //DiffPos: integer;
     ProcNode: TCodeTreeNode;
   begin
     Result:=false;
     SearchedProcHead:=ExtractProcHead(SearchForProcNode,SearchForProcAttr);
+    {$IFDEF CTDEBUG}
+    writeln('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode Searching ',ProcNode<>nil,' "',SearchedProcHead,'"');
+    {$ENDIF}
     if SearchedProcHead='' then exit;
     ProcNode:=FindProcNode(StartNode,SearchedProcHead,SearchInProcAttr);
     {$IFDEF CTDEBUG}
-    writeln('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode A ',ProcNode<>nil,' "',SearchedProcHead,'"');
+    writeln('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode Found:',ProcNode<>nil);
     {$ENDIF}
     if ProcNode<>nil then begin
       Result:=JumpToProc(SearchForProcNode,JumpToProcAttr,
@@ -302,10 +303,13 @@ const
     SearchForProcAttr:=SearchForProcAttr+[phpWithoutBrackets,
        phpWithoutParamList];
     SearchedProcHead:=ExtractProcHead(SearchForProcNode,SearchForProcAttr);
+    {$IFDEF CTDEBUG}
+    writeln('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode Searching without params "',SearchedProcHead,'"');
+    {$ENDIF}
     if SearchedProcHead='' then exit;
     ProcNode:=FindProcNode(StartNode,SearchedProcHead,SearchForProcAttr);
     {$IFDEF CTDEBUG}
-    writeln('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode B ',ProcNode<>nil,' "',SearchedProcHead,'"');
+    writeln('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode Found:',ProcNode<>nil);
     {$ENDIF}
     if ProcNode<>nil then begin
       // there is a proc with the same name, but with different parameters
@@ -434,13 +438,13 @@ begin
   // then test if cursor is in a procedure
   ProcNode:=CursorNode.GetNodeOfType(ctnProcedure);
   {$IFDEF CTDEBUG}
-  writeln('TMethodJumpingCodeTool.FindJumpPoint 2A ',ProcNode<>nil);
+  writeln('TMethodJumpingCodeTool.FindJumpPoint Checking if in a proc ... ',ProcNode<>nil);
   {$ENDIF}
   while (ProcNode<>nil) and (ProcNode.Desc=ctnProcedure) do begin
     if (ProcNode.SubDesc and ctnsForwardDeclaration)>0 then begin
       // forward declaration -> search procedure
       {$IFDEF CTDEBUG}
-      writeln('TMethodJumpingCodeTool.FindJumpPoint 2B ');
+      writeln('TMethodJumpingCodeTool.FindJumpPoint This is a forward proc ... ');
       {$ENDIF}
 
       // build the method name + parameter list (without default values)
@@ -449,6 +453,9 @@ begin
                                false);
       if Result then exit;
       
+      {$IFDEF CTDEBUG}
+      writeln('TMethodJumpingCodeTool.FindJumpPoint Searching left over ... ');
+      {$ENDIF}
       // there is no proc with same name and param list
       // gather forward procs
       if (ProcNode.Parent.Desc=ctnImplementation)

components/codetools/pascalparsertool.pas

@@ -3412,7 +3412,7 @@ begin
     // read procedure head (= name + parameterlist + resulttype;)
     CurNode:=ProcNode.FirstChild;
     ReadNextAtom;// read first atom of head
-    if IsOperator then AtomIsIdentifier(true);
+    if not IsOperator then AtomIsIdentifier(true);
     ReadNextAtom;
     if (CurPos.Flag=cafPoint) then begin
       // read procedure name of a class method (the name after the . )

components/codetools/pascalreadertool.pas

@@ -302,6 +302,9 @@ var
   GrandPaNode: TCodeTreeNode;
   TheClassName, s: string;
   HasClassName, IsProcType: boolean;
+  IsProcedure: Boolean;
+  IsFunction: Boolean;
+  IsOperator: Boolean;
 begin
   Result:='';
   ExtractProcHeadPos:=phepNone;
@@ -333,16 +336,20 @@ begin
   if (UpAtomIs('CLASS') or UpAtomIs('STATIC')) then
     ExtractNextAtom((phpWithStart in Attr)
                     and not (phpWithoutClassKeyword in Attr),Attr);
-  if (UpAtomIs('PROCEDURE')) or (UpAtomIs('FUNCTION'))
+  IsProcedure:=UpAtomIs('PROCEDURE');
+  IsProcedure:=UpAtomIs('PROCEDURE');
+  IsFunction:=(not IsProcedure) and UpAtomIs('FUNCTION');
+  IsOperator:=(not IsProcedure) and (not IsFunction) and UpAtomIs('OPERATOR');
+  if IsProcedure or IsFunction or IsOperator
   or (UpAtomIs('CONSTRUCTOR')) or (UpAtomIs('DESTRUCTOR'))
-  or (UpAtomIs('OPERATOR')) then
+  then
     ExtractNextAtom(phpWithStart in Attr,Attr)
   else
     exit;
   ExtractProcHeadPos:=phepStart;
   if not IsProcType then begin
     // read name
-    if not AtomIsIdentifier(false) then exit;
+    if (not IsOperator) and (not AtomIsIdentifier(false)) then exit;
     ReadNextAtom;
     HasClassName:=(CurPos.Flag=cafPoint);
     UndoReadNextAtom;

ide/exttooldialog.pas

@@ -388,8 +388,8 @@ begin
   for i:=0 to Count-1 do begin
     KeyCommandRelation:=KeyCommandRelationList.FindByCommand(ecExtToolFirst+i);
     if KeyCommandRelation<>nil then begin
-      KeyCommandRelation.KeyA:=IDECommandKey(Items[i].Key,Items[i].Shift,
+      KeyCommandRelation.KeyA:=IDEShortCut(Items[i].Key,Items[i].Shift,
-                                             VK_UNKNOWN,[]);
+                                           VK_UNKNOWN,[]);
     end else begin
       writeln('[TExternalToolList.SaveShortCuts] Error: '
         +'unable to save shortcut for external tool "',Items[i].Title,'"');

ide/keymapping.pp

@@ -280,7 +280,7 @@ type
     function AddCategory(const Name, Description: string;
        TheAreas: TCommandAreas): integer;
     function Add(Category: TKeyCommandCategory; const Name: string;
-       Command:word;  const TheKeyA, TheKeyB: TIDECommandKey):integer;
+       Command:word;  const TheKeyA, TheKeyB: TIDEShortCut):integer;
     function AddDefault(Category: TKeyCommandCategory; const Name: string;
        Command:word):integer;
     procedure SetCustomKeyCount(const NewCount: integer);
@@ -359,13 +359,13 @@ function EditorCommandLocalizedName(cmd: word;
 function EditorKeyStringToVKCode(const s: string): integer;
 
 procedure GetDefaultKeyForCommand(Command: word;
-  var TheKeyA, TheKeyB: TIDECommandKey);
+  var TheKeyA, TheKeyB: TIDEShortCut);
 procedure GetDefaultKeyForClassicScheme(Command: word;
-  var TheKeyA, TheKeyB: TIDECommandKey);
+  var TheKeyA, TheKeyB: TIDEShortCut);
 function KeySchemeNameToSchemeType(const SchemeName: string): TKeyMapScheme;
 
 function ShiftStateToStr(Shift:TShiftState):AnsiString;
-function KeyValuesToStr(const KeyA, KeyB: TIDECommandKey): string;
+function KeyValuesToStr(const KeyA, KeyB: TIDEShortCut): string;
 function EditorKeyStringIsIrregular(const s: string): boolean;
 
 var KeyMappingEditForm: TKeyMappingEditForm;
@@ -417,13 +417,13 @@ begin
 end;
 
 procedure GetDefaultKeyForCommand(Command: word;
-  var TheKeyA, TheKeyB: TIDECommandKey);
+  var TheKeyA, TheKeyB: TIDEShortCut);
 
   procedure SetResult(NewKeyA: word; NewShiftA: TShiftState;
     NewKeyB: word; NewShiftB: TShiftState);
   begin
-    TheKeyA:=IDECommandKey(NewKeyA,NewShiftA,VK_UNKNOWN,[]);
+    TheKeyA:=IDEShortCut(NewKeyA,NewShiftA,VK_UNKNOWN,[]);
-    TheKeyB:=IDECommandKey(NewKeyB,NewShiftB,VK_UNKNOWN,[]);
+    TheKeyB:=IDEShortCut(NewKeyB,NewShiftB,VK_UNKNOWN,[]);
   end;
 
   procedure SetResult(NewKeyA: word; NewShiftA: TShiftState);
@@ -684,13 +684,13 @@ begin
 end;
 
 procedure GetDefaultKeyForClassicScheme(Command: word;
-  var TheKeyA, TheKeyB: TIDECommandKey);
+  var TheKeyA, TheKeyB: TIDEShortCut);
   
   procedure SetResult(NewKeyA: word; NewShiftA: TShiftState;
     NewKeyB: word; NewShiftB: TShiftState);
   begin
-    TheKeyA:=IDECommandKey(NewKeyA,NewShiftA,VK_UNKNOWN,[]);
+    TheKeyA:=IDEShortCut(NewKeyA,NewShiftA,VK_UNKNOWN,[]);
-    TheKeyB:=IDECommandKey(NewKeyB,NewShiftB,VK_UNKNOWN,[]);
+    TheKeyB:=IDEShortCut(NewKeyB,NewShiftB,VK_UNKNOWN,[]);
   end;
 
   procedure SetResult(NewKeyA: word; NewShiftA: TShiftState);
@@ -906,7 +906,7 @@ begin
   Result:=IntToStr(i);
 end;
 
-function KeyValuesToStr(const KeyA, KeyB: TIDECommandKey): string;
+function KeyValuesToStr(const KeyA, KeyB: TIDEShortCut): string;
 begin
   Result:=IntToStr(KeyA.Key1)+','+ShiftStateToStr(KeyA.Shift1)
         +','+IntToStr(KeyB.Key1)+','+ShiftStateToStr(KeyB.Shift1);
@@ -1652,8 +1652,8 @@ begin
     NewKey2:=VK_UNKNOWN;
   end;
 
-  CurRelation.KeyA:=IDECommandKey(NewKey1,NewShiftState1,VK_UNKNOWN,[]);
+  CurRelation.KeyA:=IDEShortCut(NewKey1,NewShiftState1,VK_UNKNOWN,[]);
-  CurRelation.KeyB:=IDECommandKey(NewKey2,NewShiftState2,VK_UNKNOWN,[]);
+  CurRelation.KeyB:=IDEShortCut(NewKey2,NewShiftState2,VK_UNKNOWN,[]);
   ModalResult:=mrOk;
 end;
 
@@ -2087,16 +2087,16 @@ end;
 
 function TKeyCommandRelationList.Add(Category: TKeyCommandCategory;
   const Name: string;
-  Command:word; const TheKeyA, TheKeyB: TIDECommandKey):integer;
+  Command:word; const TheKeyA, TheKeyB: TIDEShortCut):integer;
 begin
-  Result:=FRelations.Add(TKeyCommandRelation.Create(Category,Name,Command
+  Result:=FRelations.Add(TKeyCommandRelation.Create(Category,Name,Command,
-      ,TheKeyA, TheKeyB));
+                         TheKeyA,TheKeyB));
 end;
 
 function TKeyCommandRelationList.AddDefault(Category: TKeyCommandCategory;
   const Name: string; Command: word): integer;
 var
-  TheKeyA, TheKeyB: TIDECommandKey;
+  TheKeyA, TheKeyB: TIDEShortCut;
 begin
   GetDefaultKeyForCommand(Command,TheKeyA,TheKeyB);
   Result:=Add(Category,Name,Command,TheKeyA,TheKeyB);
@@ -2114,7 +2114,7 @@ begin
     while NewCount>FCustomKeyCount do begin
       Add(CustomCat,Format(srkmecCustomTool,[FCustomKeyCount]),
           ecCustomToolFirst+FCustomKeyCount,
-          CleanIDECommandKey,CleanIDECommandKey);
+          CleanIDEShortCut,CleanIDEShortCut);
       inc(FCustomKeyCount);
     end;
   end else begin
@@ -2146,7 +2146,7 @@ begin
     // increase available external tool commands
     while NewCount>fExtToolCount do begin
       Add(ExtToolCat,Format(srkmecExtTool,[fExtToolCount]),
-           ecExtToolFirst+fExtToolCount,CleanIDECommandKey,CleanIDECommandKey);
+           ecExtToolFirst+fExtToolCount,CleanIDEShortCut,CleanIDEShortCut);
       inc(fExtToolCount);
     end;
   end else begin
@@ -2197,7 +2197,7 @@ var a,b,p:integer;
 // LoadFromXMLConfig
 var
   FileVersion: integer;
-  TheKeyA, TheyKeyB: TIDECommandKey;
+  TheKeyA, TheyKeyB: TIDEShortCut;
   Key: word;
   Shift: TShiftState;
 begin
@@ -2218,10 +2218,10 @@ begin
     p:=1;
     Key:=ReadNextInt;
     Shift:=IntToShiftState(ReadNextInt);
-    Relations[a].KeyA:=IDECommandKey(Key,Shift,VK_UNKNOWN,[]);
+    Relations[a].KeyA:=IDEShortCut(Key,Shift,VK_UNKNOWN,[]);
     Key:=ReadNextInt;
     Shift:=IntToShiftState(ReadNextInt);
-    Relations[a].KeyB:=IDECommandKey(Key,Shift,VK_UNKNOWN,[]);
+    Relations[a].KeyB:=IDEShortCut(Key,Shift,VK_UNKNOWN,[]);
   end;
   Result:=true;
 end;
@@ -2232,7 +2232,7 @@ var a,b: integer;
   Name: String;
   CurKeyStr: String;
   DefaultKeyStr: string;
-  TheKeyA, TheyKeyB: TIDECommandKey;
+  TheKeyA, TheyKeyB: TIDEShortCut;
 begin
   XMLConfig.SetValue(Prefix+'Version/Value',KeyMappingFormatVersion);
   XMLConfig.SetDeleteValue(Prefix+'ExternalToolCount/Value',ExtToolCount,0);
@@ -2373,7 +2373,7 @@ var
   i: Integer;
   CurRelation: TKeyCommandRelation;
   NewScheme: TKeyMapScheme;
-  TheKeyA, TheKeyB: TIDECommandKey;
+  TheKeyA, TheKeyB: TIDEShortCut;
 begin
   NewScheme:=KeySchemeNameToSchemeType(SchemeName);
   // set all keys to new scheme

ideintf/idecommands.pas

@@ -11,7 +11,22 @@
  *****************************************************************************
 
  Abstract:
+   Under construction by Mattias
+ 
+ 
    Interface unit for IDE commands.
+   IDE commands are functions like open file, save, build, ... .
+   
+   Every command can have up to two shortcuts. For example:
+     ecCopy: two shortcuts: Ctrl+C and Ctrl+Insert
+     ecDeleteChar: one shortcut: Delete
+     ecInsertDateTime: no shortcut
+   
+   Commands are sorted into categories. For example:
+     ecCopy is in the category 'Selection'.
+     
+   Every command can have a menu item.
+
 }
 unit IDECommands;
 
@@ -23,12 +38,10 @@ uses
   Classes, SysUtils, LCLType;
   
 type
-  TIDECommandCategory = class;
-
   TCommandArea = (caSourceEditor, caDesigner);
   TCommandAreas = set of TCommandArea;
   
-  TIDECommandKey = record
+  TIDEShortCut = record
     Key1: word;
     Shift1: TShiftState;
     Key2: word;
@@ -36,34 +49,7 @@ type
   end;
 
   //---------------------------------------------------------------------------
-  // class for storing the keys of a single command (key-command relationship)
+  // TIDECommandCategory is used to divide the commands in handy packets
-  TIDECommandKeys = class
-  private
-    FCategory: TIDECommandCategory;
-    FCommand: word;
-    FLocalizedName: string;
-    FName: String;
-  protected
-    function GetLocalizedName: string; virtual;
-    procedure SetLocalizedName(const AValue: string); virtual;
-    procedure SetCategory(const AValue: TIDECommandCategory); virtual;
-  public
-    function AsShortCut: TShortCut; virtual;
-    constructor Create(TheCategory: TIDECommandCategory; const TheName: String;
-      TheCommand: word; const TheKeyA, TheKeyB: TIDECommandKey);
-  public
-    KeyA: TIDECommandKey;
-    KeyB: TIDECommandKey;
-    DefaultKeyA: TIDECommandKey;
-    DefaultKeyB: TIDECommandKey;
-    property Name: String read FName;
-    property Command: word read FCommand;  // see the ecXXX constants above
-    property LocalizedName: string read GetLocalizedName write SetLocalizedName;
-    property Category: TIDECommandCategory read FCategory write SetCategory;
-  end;
-
-  //---------------------------------------------------------------------------
-  // TIDECommandCategory is used to divide the key commands in handy packets
   TIDECommandCategory = class(TList)
   protected
     FAreas: TCommandAreas;
@@ -77,20 +63,48 @@ type
     property Areas: TCommandAreas read FAreas;
     procedure Delete(Index: Integer); virtual;
   end;
-  
+
+  //---------------------------------------------------------------------------
+  // class for storing the keys of a single command
+  // (shortcut-command relationship)
+  TIDECommandKeys = class
+  private
+    FCategory: TIDECommandCategory;
+    FCommand: word;
+    FLocalizedName: string;
+    FName: String;
+  protected
+    function GetLocalizedName: string; virtual;
+    procedure SetLocalizedName(const AValue: string); virtual;
+    procedure SetCategory(const AValue: TIDECommandCategory); virtual;
+  public
+    function AsShortCut: TShortCut; virtual;
+    constructor Create(TheCategory: TIDECommandCategory; const TheName: String;
+      TheCommand: word; const TheKeyA, TheKeyB: TIDEShortCut);
+  public
+    KeyA: TIDEShortCut;
+    KeyB: TIDEShortCut;
+    DefaultKeyA: TIDEShortCut;
+    DefaultKeyB: TIDEShortCut;
+    property Name: String read FName;
+    property Command: word read FCommand;  // see the ecXXX constants above
+    property LocalizedName: string read GetLocalizedName write SetLocalizedName;
+    property Category: TIDECommandCategory read FCategory write SetCategory;
+  end;
+
 const
-  CleanIDECommandKey: TIDECommandKey =
+  CleanIDEShortCut: TIDEShortCut =
     (Key1: VK_UNKNOWN; Shift1: []; Key2: VK_UNKNOWN; Shift2: []);
 
-function IDECommandKey(Key1: word; Shift1: TShiftState;
+function IDEShortCut(Key1: word; Shift1: TShiftState;
-  Key2: word; Shift2: TShiftState): TIDECommandKey;
+  Key2: word; Shift2: TShiftState): TIDEShortCut;
 
 
 implementation
 
 
-function IDECommandKey(Key1: word; Shift1: TShiftState;
+function IDEShortCut(Key1: word; Shift1: TShiftState;
-  Key2: word; Shift2: TShiftState): TIDECommandKey;
+  Key2: word; Shift2: TShiftState): TIDEShortCut;
 begin
   Result.Key1:=Key1;
   Result.Shift1:=Shift1;
@@ -135,14 +149,14 @@ end;
 
 function TIDECommandKeys.AsShortCut: TShortCut;
 var
-  CurKey: TIDECommandKey;
+  CurKey: TIDEShortCut;
 begin
   if (KeyA.Key1<>VK_UNKNOWN) and (KeyA.Key2=VK_UNKNOWN) then
     CurKey:=KeyA
   else if (KeyB.Key1<>VK_UNKNOWN) and (KeyB.Key2=VK_UNKNOWN) then
     CurKey:=KeyB
   else
-    CurKey:=CleanIDECommandKey;
+    CurKey:=CleanIDEShortCut;
   Result:=CurKey.Key1;
   if ssCtrl in CurKey.Shift1 then
     Result:=Result+scCtrl;
@@ -154,7 +168,7 @@ end;
 
 constructor TIDECommandKeys.Create(TheCategory: TIDECommandCategory;
   const TheName: String; TheCommand: word;
-  const TheKeyA, TheKeyB: TIDECommandKey);
+  const TheKeyA, TheKeyB: TIDEShortCut);
 begin
   fCommand:=TheCommand;
   fName:=TheName;