small bugfixes and fixed non checked menu items activate

git-svn-id: trunk@3830 -

components/codetools/codetoolmanager.pas

@@ -237,9 +237,10 @@ type
     function GatherIdentifiers(Code: TCodeBuffer; X,Y: integer): boolean;
     
     // expressions
-    function GetExpressionBounds(Code: TCodeBuffer; X,Y: integer;
+    function GetStringConstBounds(Code: TCodeBuffer; X,Y: integer;
           var StartCode: TCodeBuffer; var StartX, StartY: integer;
-          var EndCode: TCodeBuffer; var EndX, EndY: integer): boolean;
+          var EndCode: TCodeBuffer; var EndX, EndY: integer;
+          ResolveComments: boolean): boolean;
 
     // functions for events in the object inspector
     function GetCompatiblePublishedMethods(Code: TCodeBuffer;
@@ -798,22 +799,24 @@ begin
   {$ENDIF}
 end;
 
-function TCodeToolManager.GetExpressionBounds(Code: TCodeBuffer; X, Y: integer;
+function TCodeToolManager.GetStringConstBounds(Code: TCodeBuffer; X, Y: integer;
   var StartCode: TCodeBuffer; var StartX, StartY: integer;
-  var EndCode: TCodeBuffer; var EndX, EndY: integer): boolean;
+  var EndCode: TCodeBuffer; var EndX, EndY: integer;
+  ResolveComments: boolean): boolean;
 var
   CursorPos, StartPos, EndPos: TCodeXYPosition;
 begin
   Result:=false;
   {$IFDEF CTDEBUG}
-  writeln('TCodeToolManager.GetExpressionBounds A ',Code.Filename,' x=',x,' y=',y);
+  writeln('TCodeToolManager.GetStringConstBounds A ',Code.Filename,' x=',x,' y=',y);
   {$ENDIF}
   if not InitCurCodeTool(Code) then exit;
   CursorPos.X:=X;
   CursorPos.Y:=Y;
   CursorPos.Code:=Code;
   try
-    Result:=FCurCodeTool.GetExpressionBounds(CursorPos,StartPos,EndPos);
+    Result:=FCurCodeTool.GetStringConstBounds(CursorPos,StartPos,EndPos,
+                                              ResolveComments);
     if Result then begin
       StartCode:=StartPos.Code;
       StartX:=StartPos.X;

components/codetools/customcodetool.pas

@@ -54,6 +54,7 @@ const
 type
   TCustomCodeTool = class;
 
+
   // types for errors
   ECodeToolError = class(Exception)
     Sender: TCustomCodeTool;
@@ -62,6 +63,13 @@ type
   
   ECodeToolErrors = class of ECodeToolError;
   
+  ECodeToolFileNotFound = class(ECodeToolError)
+    Filename: string;
+    constructor Create(ASender: TCustomCodeTool;
+      const AMessage, AFilename: string);
+  end;
+  
+  
   // types for user aborts
   TOnParserProgress = function(Tool: TCustomCodeTool): boolean of object;
 
@@ -99,6 +107,7 @@ type
     LastErrorBehindIgnorePosition: boolean;
     LastErrorCheckedForIgnored: boolean;
     CurrentPhase: integer;
+    procedure RaiseExceptionInstance(Exception: ECodeToolError); virtual;
     procedure RaiseExceptionClass(const AMessage: string;
       ExceptionClass: ECodeToolErrors); virtual;
     procedure RaiseException(const AMessage: string); virtual;
@@ -1681,8 +1690,7 @@ begin
     Scanner.SetIgnoreErrorAfter(IgnoreErrorAfter.P,IgnoreErrorAfter.Code);
 end;
 
-procedure TCustomCodeTool.RaiseExceptionClass(const AMessage: string;
+procedure TCustomCodeTool.RaiseExceptionInstance(Exception: ECodeToolError);
-  ExceptionClass: ECodeToolErrors);
 var CaretXY: TCodeXYPosition;
   CursorPos: integer;
   Node: TCodeTreeNode;
@@ -1708,7 +1716,13 @@ begin
   end;
   // raise the exception
   CurrentPhase:=CodeToolPhaseNone;
-  raise ExceptionClass.Create(Self,AMessage);
+  raise Exception;
+end;
+
+procedure TCustomCodeTool.RaiseExceptionClass(const AMessage: string;
+  ExceptionClass: ECodeToolErrors);
+begin
+  RaiseExceptionInstance(ExceptionClass.Create(Self,AMessage));
 end;
 
 function TCustomCodeTool.DefaultKeyWordFunc: boolean;
@@ -2154,4 +2168,13 @@ begin
   Sender:=ASender;
 end;
 
+{ ECodeToolFileNotFound }
+
+constructor ECodeToolFileNotFound.Create(ASender: TCustomCodeTool;
+  const AMessage, AFilename: string);
+begin
+  inherited Create(ASender,AMessage);
+  Filename:=AFilename;
+end;
+
 end.

components/codetools/finddeclarationtool.pas

@@ -82,6 +82,9 @@ uses
 type
   TFindDeclarationTool = class;
   
+  //----------------------------------------------------------------------------
+  // variable atoms
+
   TVariableAtomType = (
     vatNone,             // undefined
     vatSpace,            // empty or space
@@ -117,12 +120,14 @@ const
      );
      
 type
+  //----------------------------------------------------------------------------
   // searchpath delimiter is semicolon
   TOnGetSearchPath = function(Sender: TObject): string of object;
   
   TOnGetCodeToolForBuffer = function(Sender: TObject;
     Code: TCodeBuffer): TFindDeclarationTool of object;
 
+  //----------------------------------------------------------------------------
   // flags/states for searching
   TFindDeclarationFlag = (
     fdfSearchInAncestors,   // if context is a class, search also in
@@ -191,6 +196,7 @@ type
   TFoundDeclarationFlags = set of TFoundDeclarationFlag;
 
 
+  //----------------------------------------------------------------------------
   TFindDeclarationParams = class;
   
   TFindContext = record
@@ -202,6 +208,7 @@ const
   CleanFindContext: TFindContext = (Node:nil; Tool:nil);
   
 type
+  //----------------------------------------------------------------------------
   { TExpressionTypeDesc describes predefined types
     The Freepascal compiler can automatically convert them
   }
@@ -313,6 +320,7 @@ const
     (Desc:xtNone; SubDesc:xtNone; Context:(Node:nil; Tool:nil));
 
 type
+  //----------------------------------------------------------------------------
   // TTypeCompatibility is the result of a compatibility check
   TTypeCompatibility = (
     tcExact,        // exactly same type
@@ -329,6 +337,7 @@ const
      );
 
 type
+  //----------------------------------------------------------------------------
   // TExprTypeList is used for compatibility checks of whole parameter lists
   TExprTypeList = class
   private
@@ -346,6 +355,7 @@ type
     function AsString: string;
   end;
   
+  //----------------------------------------------------------------------------
   // TFoundProc is used for comparing overloaded procs
   TFoundProc = record
     // the expression input list, which should fit into the searched proc
@@ -424,6 +434,7 @@ type
   end;
   
   
+  //----------------------------------------------------------------------------
   // TFindDeclarationTool is source based and can therefore search for more
   // than declarations:
   TFindSmartFlag = (
@@ -440,6 +451,11 @@ const
 
 
 type
+  //----------------------------------------------------------------------------
+  ECodeToolUnitNotFound = class(ECodeToolFileNotFound)
+  end;
+
+  //----------------------------------------------------------------------------
 
   { TFindDeclarationTool }
 
@@ -1044,7 +1060,8 @@ begin
         UnitInFilename:='';
       NewPos.Code:=FindUnitSource(UnitName,UnitInFilename);
       if NewPos.Code=nil then
-        RaiseExceptionFmt(ctsUnitNotFound,[UnitName]);
+        RaiseExceptionInstance(
+          ECodeToolUnitNotFound.Create(Self,ctsUnitNotFound,UnitName));
       NewPos.X:=1;
       NewPos.Y:=1;
       NewTopLine:=1;
@@ -3042,7 +3059,9 @@ begin
       NewCodeTool:=FindCodeToolForUsedUnit(UnitNameAtom,InAtom,false);
       if NewCodeTool=nil then begin
         MoveCursorToCleanPos(UnitNameAtom.StartPos);
-        RaiseExceptionFmt(ctsUnitNotFound,[GetAtom(UnitNameAtom)]);
+        RaiseExceptionInstance(
+          ECodeToolUnitNotFound.Create(Self,ctsUnitNotFound,
+                                       GetAtom(UnitNameAtom)));
       end else if NewCodeTool=Self then begin
         MoveCursorToCleanPos(UnitNameAtom.StartPos);
         RaiseExceptionFmt(ctsIllegalCircleInUsedUnits,[GetAtom(UnitNameAtom)]);
@@ -3239,7 +3258,8 @@ begin
   if (NewCode=nil) then begin
     // no source found
     CurPos.StartPos:=-1;
-    RaiseExceptionFmt(ctsUnitNotFound,[AnUnitName]);
+    RaiseExceptionInstance(
+      ECodeToolUnitNotFound.Create(Self,ctsUnitNotFound,AnUnitName));
   end else if NewCode=TCodeBuffer(Scanner.MainCode) then begin
     // Searching again in hidden unit
     writeln('WARNING: Searching again in hidden unit: "',NewCode.Filename,'"');
@@ -3254,7 +3274,8 @@ begin
       NewCodeTool:=FOnGetCodeToolForBuffer(Self,NewCode);
       if NewCodeTool=nil then begin
         CurPos.StartPos:=-1;
-        RaiseExceptionFmt(ctsUnitNotFound,[AnUnitName]);
+        RaiseExceptionInstance(
+          ECodeToolUnitNotFound.Create(Self,ctsUnitNotFound,AnUnitName));
       end;
     end else if NewCode=TCodeBuffer(Scanner.MainCode) then begin
       NewCodeTool:=Self;

components/codetools/stdcodetools.pas

@@ -157,8 +157,9 @@ type
           SourceChangeCache: TSourceChangeCache): boolean;
 
     // expressions
-    function GetExpressionBounds(CursorPos: TCodeXYPosition;
+    function GetStringConstBounds(CursorPos: TCodeXYPosition;
-          var StartPos, EndPos: TCodeXYPosition): boolean;
+          var StartPos, EndPos: TCodeXYPosition;
+          ResolveComments: boolean): boolean;
   end;
 
 
@@ -1184,18 +1185,142 @@ begin
   Result:=true;
 end;
 
-function TStandardCodeTool.GetExpressionBounds(CursorPos: TCodeXYPosition;
+function TStandardCodeTool.GetStringConstBounds(CursorPos: TCodeXYPosition;
-  var StartPos, EndPos: TCodeXYPosition): boolean;
+  var StartPos, EndPos: TCodeXYPosition; ResolveComments: boolean): boolean;
+// examples:
+//   's1'+'s2'#13+AFunction(...)+inherited AMethod
+type
+  TStrConstTokenType = (scatNone, scatStrConst, scatPlus, scatIdent,
+    scatInherited, scatPoint, scatUp,
+    scatEdgedBracketOpen, scatEdgedBracketClose,
+    scatRoundBracketOpen, scatRoundBracketClose);
+    
+  function GetCurrentTokenType: TStrConstTokenType;
+  begin
+    if AtomIsStringConstant then
+      Result:=scatStrConst
+    else if AtomIsChar('+') then
+      Result:=scatPlus
+    else if UpAtomIs('INHERITED') then
+      Result:=scatInherited
+    else if AtomIsIdentifier(false) then
+      Result:=scatIdent
+    else if CurPos.Flag=cafPoint then
+      Result:=scatPoint
+    else if AtomIsChar('^') then
+      Result:=scatUp
+    else
+      Result:=scatNone;
+  end;
+  
 var
   CleanCursorPos: integer;
-  CursorNode: TCodeTreeNode;
+  SameArea: TAtomPosition;
+  LastToken, CurrentToken: TStrConstTokenType;
+  StartCleanPos, EndCleanPos: integer;
 begin
-  Result:=false;
+  StartPos:=CursorPos;
+  EndPos:=CursorPos;
+  Result:=true;
   BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
-  CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
+  GetCleanPosInfo(-1,CleanCursorPos,ResolveComments,SameArea);
-  MoveCursorToNodeStart(CursorNode);
+  if (SameArea.EndPos=SameArea.StartPos) or (SameArea.StartPos>SrcLen) then
+    exit;
+  // read til end of string constant
+  MoveCursorToCleanPos(SameArea.StartPos);
   ReadNextAtom;
+  CurrentToken:=GetCurrentTokenType;
+  if (CurrentToken=scatNone) then exit;
+  repeat
+    EndCleanPos:=CurPos.EndPos;
+    ReadNextAtom;
+    LastToken:=CurrentToken;
+    CurrentToken:=GetCurrentTokenType;
+    case CurrentToken of
+    scatNone, scatEdgedBracketClose, scatRoundBracketClose:
+      if not (LastToken in [scatStrConst,scatIdent,scatUp,
+         scatEdgedBracketClose, scatRoundBracketClose])
+      then
+        exit
+      else
+        break;
 
+    scatStrConst:
+      if not (LastToken in [scatPlus]) then exit;
+      
+    scatPlus:
+      if not (LastToken in [scatStrConst, scatIdent, scatUp,
+        scatEdgedBracketClose, scatRoundBracketClose]) then exit;
+
+    scatIdent:
+      if not (LastToken in [scatPlus, scatPoint, scatInherited]) then exit;
+
+    scatInherited:
+      if not (LastToken in [scatPlus, scatPoint]) then exit;
+
+    scatPoint:
+      if not (LastToken in [scatIdent, scatUp]) then exit;
+
+    scatEdgedBracketOpen,scatRoundBracketOpen:
+      if not (LastToken in [scatIdent, scatUp]) then
+        exit
+      else begin
+        ReadTilBracketClose(true);
+        CurrentToken:=GetCurrentTokenType;
+      end;
+      
+    end;
+  until false;
+
+  // read til end of string constant
+  MoveCursorToCleanPos(SameArea.StartPos);
+  ReadNextAtom;
+  CurrentToken:=GetCurrentTokenType;
+  repeat
+    StartCleanPos:=CurPos.EndPos;
+    ReadPriorAtom;
+    LastToken:=CurrentToken;
+    CurrentToken:=GetCurrentTokenType;
+    case CurrentToken of
+    scatNone, scatEdgedBracketOpen, scatRoundBracketOpen:
+      if not (LastToken in [scatStrConst,scatIdent]) then
+        exit
+      else
+        break;
+
+    scatStrConst:
+      if not (LastToken in [scatPlus]) then exit;
+
+    scatPlus:
+      if not (LastToken in [scatStrConst, scatIdent, scatRoundBracketOpen]) then
+        exit;
+
+    scatIdent:
+      if not (LastToken in [scatPlus, scatPoint, scatUp, scatRoundBracketOpen,
+        scatEdgedBracketOpen]) then exit;
+
+    scatInherited:
+      if not (LastToken in [scatIdent]) then exit;
+
+    scatPoint:
+      if not (LastToken in [scatIdent]) then exit;
+
+    scatEdgedBracketClose,scatRoundBracketClose:
+      if not (LastToken in [scatPlus, scatUp, scatPoint]) then
+        exit
+      else begin
+        ReadBackTilBracketOpen(true);
+        CurrentToken:=GetCurrentTokenType;
+      end;
+
+    end;
+  until false;
+  
+  // convert start and end position
+  if not CleanPosToCaret(StartCleanPos,StartPos) then exit;
+  if not CleanPosToCaret(EndCleanPos,EndPos) then exit;
+
+  Result:=true;
 end;
 
 function TStandardCodeTool.FindPublishedVariable(const UpperClassName,

components/synedit/synhighlighterpas.pp

@@ -477,17 +477,23 @@ end;
 
 {$IFDEF SYN_LAZARUS}
 function TSynPasSyn.KeyHash: Integer;
-var ToHash: integer;
+var
+  Start, ToHash: PChar;
 begin
   Result := 0;
-  ToHash := fToIdent;
+  if (fToIdent<=fLineLen) and (fLine<>'') then begin
-  while (ToHash<=fLineLen) and (IsLetterChar[fLine[ToHash]]) do begin
+    Start := PChar(fLine) + fToIdent - 1;
-    inc(Result, mHashTable[fLine[ToHash]]);
+    ToHash := Start;
+    while (IsLetterChar[ToHash^]) do begin
+      inc(Result, mHashTable[ToHash^]);
       inc(ToHash);
     end;
-  if (ToHash<=fLineLen) and IsUnderScoreOrNumberChar[fLine[ToHash]] then
+    if IsUnderScoreOrNumberChar[ToHash^] then
       inc(ToHash);
-  fStringLen := ToHash - fToIdent;
+    fStringLen := integer(ToHash) - integer(Start);
+  end else begin
+    fStringLen := 0;
+  end;
 end; { KeyHash }
 {$ELSE}
 function TSynPasSyn.KeyHash(ToHash: PChar): Integer;
@@ -506,23 +512,19 @@ end; { KeyHash }
 function TSynPasSyn.KeyComp(const aKey: string): Boolean;
 var
   I: Integer;
-  {$IFDEF SYN_LAZARUS}
-  Temp: Integer;
-  {$ELSE}
   Temp: PChar;
-  {$ENDIF}
 begin
-  Temp := fToIdent;
   if Length(aKey) = fStringLen then
   begin
+    {$IFDEF SYN_LAZARUS}
+    Temp := PChar(fLine) + fToIdent - 1;
+    {$ELSE}
+    Temp := fToIdent;
+    {$ENDIF}
     Result := True;
     for i := 1 to fStringLen do
     begin
-      {$IFDEF SYN_LAZARUS}
-      if mHashTable[fLine[Temp]] <> mHashTable[aKey[i]] then
-      {$ELSE}
       if mHashTable[Temp^] <> mHashTable[aKey[i]] then
-      {$ENDIF}
       begin
         Result := False;
         break;