implemented proc jumping for operators

git-svn-id: trunk@4938 -
2025-04-08 00:02:03 +02:00 · 2003-12-23 14:20:33 +00:00 · 2003-12-23 14:20:33 +00:00 · f5041c8164
commit f5041c8164
parent 4d53e93709
8 changed files with 111 additions and 80 deletions
--- a/components/codetools/customcodetool.pas
+++ b/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
--- a/components/codetools/finddeclarationtool.pas
+++ b/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)
-    or CompareSrcIdentifiers(NameAtom.StartPos,Params.Identifier) then begin
+    if ((fdfCollect in Params.Flags)
+    or CompareSrcIdentifiers(NameAtom.StartPos,Params.Identifier)) then begin
      // proc identifier found
      {$IFDEF ShowTriedContexts}
      writeln('[TFindDeclarationTool.FindIdentifierInProcContext]  Proc-Identifier found="',GetIdentifier(Params.Identifier),'"');
--- a/components/codetools/methodjumptool.pas
+++ b/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;
-    //FromProcHead, ToProcHead: string;
-    //Attr: TProcHeadAttributes;
-    //DiffPos: integer;
+  var
+    SearchedProcHead: string;
    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)
--- a/components/codetools/pascalparsertool.pas
+++ b/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 . )
--- a/components/codetools/pascalreadertool.pas
+++ b/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;
--- a/ide/exttooldialog.pas
+++ b/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,
-                                             VK_UNKNOWN,[]);
+      KeyCommandRelation.KeyA:=IDEShortCut(Items[i].Key,Items[i].Shift,
+                                           VK_UNKNOWN,[]);
    end else begin
      writeln('[TExternalToolList.SaveShortCuts] Error: '
        +'unable to save shortcut for external tool "',Items[i].Title,'"');
--- a/ide/keymapping.pp
+++ b/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,[]);
-    TheKeyB:=IDECommandKey(NewKeyB,NewShiftB,VK_UNKNOWN,[]);
+    TheKeyA:=IDEShortCut(NewKeyA,NewShiftA,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,[]);
-    TheKeyB:=IDECommandKey(NewKeyB,NewShiftB,VK_UNKNOWN,[]);
+    TheKeyA:=IDEShortCut(NewKeyA,NewShiftA,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.KeyB:=IDECommandKey(NewKey2,NewShiftState2,VK_UNKNOWN,[]);
+  CurRelation.KeyA:=IDEShortCut(NewKey1,NewShiftState1,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
-      ,TheKeyA, TheKeyB));
+  Result:=FRelations.Add(TKeyCommandRelation.Create(Category,Name,Command,
+                         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
--- a/ideintf/idecommands.pas
+++ b/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)
-  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 is used to divide the 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;
-  Key2: word; Shift2: TShiftState): TIDECommandKey;
+function IDEShortCut(Key1: word; Shift1: TShiftState;
+  Key2: word; Shift2: TShiftState): TIDEShortCut;


 implementation


-function IDECommandKey(Key1: word; Shift1: TShiftState;
-  Key2: word; Shift2: TShiftState): TIDECommandKey;
+function IDEShortCut(Key1: word; Shift1: TShiftState;
+  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;