mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-31 16:52:37 +02:00
small bugfixes and fixed non checked menu items activate
git-svn-id: trunk@3830 -
This commit is contained in:
mattias
parent
5f1430afcb
commit
f30cb77bc9
@ -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;
|
||||
|
||||
@ -54,6 +54,7 @@ const
|
||||
type
|
||||
TCustomCodeTool = class;
|
||||
|
||||
|
||||
// types for errors
|
||||
ECodeToolError = class(Exception)
|
||||
Sender: TCustomCodeTool;
|
||||
@ -61,7 +62,14 @@ type
|
||||
end;
|
||||
|
||||
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;
|
||||
ExceptionClass: ECodeToolErrors);
|
||||
procedure TCustomCodeTool.RaiseExceptionInstance(Exception: ECodeToolError);
|
||||
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.
|
||||
|
||||
@ -81,6 +81,9 @@ uses
|
||||
|
||||
type
|
||||
TFindDeclarationTool = class;
|
||||
|
||||
//----------------------------------------------------------------------------
|
||||
// variable atoms
|
||||
|
||||
TVariableAtomType = (
|
||||
vatNone, // undefined
|
||||
@ -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;
|
||||
|
||||
@ -157,8 +157,9 @@ type
|
||||
SourceChangeCache: TSourceChangeCache): boolean;
|
||||
|
||||
// expressions
|
||||
function GetExpressionBounds(CursorPos: TCodeXYPosition;
|
||||
var StartPos, EndPos: TCodeXYPosition): boolean;
|
||||
function GetStringConstBounds(CursorPos: TCodeXYPosition;
|
||||
var StartPos, EndPos: TCodeXYPosition;
|
||||
ResolveComments: boolean): boolean;
|
||||
end;
|
||||
|
||||
|
||||
@ -1184,18 +1185,142 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TStandardCodeTool.GetExpressionBounds(CursorPos: TCodeXYPosition;
|
||||
var StartPos, EndPos: TCodeXYPosition): boolean;
|
||||
function TStandardCodeTool.GetStringConstBounds(CursorPos: TCodeXYPosition;
|
||||
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);
|
||||
MoveCursorToNodeStart(CursorNode);
|
||||
GetCleanPosInfo(-1,CleanCursorPos,ResolveComments,SameArea);
|
||||
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,
|
||||
|
||||
@ -477,17 +477,23 @@ end;
|
||||
|
||||
{$IFDEF SYN_LAZARUS}
|
||||
function TSynPasSyn.KeyHash: Integer;
|
||||
var ToHash: integer;
|
||||
var
|
||||
Start, ToHash: PChar;
|
||||
begin
|
||||
Result := 0;
|
||||
ToHash := fToIdent;
|
||||
while (ToHash<=fLineLen) and (IsLetterChar[fLine[ToHash]]) do begin
|
||||
inc(Result, mHashTable[fLine[ToHash]]);
|
||||
inc(ToHash);
|
||||
if (fToIdent<=fLineLen) and (fLine<>'') then begin
|
||||
Start := PChar(fLine) + fToIdent - 1;
|
||||
ToHash := Start;
|
||||
while (IsLetterChar[ToHash^]) do begin
|
||||
inc(Result, mHashTable[ToHash^]);
|
||||
inc(ToHash);
|
||||
end;
|
||||
if IsUnderScoreOrNumberChar[ToHash^] then
|
||||
inc(ToHash);
|
||||
fStringLen := integer(ToHash) - integer(Start);
|
||||
end else begin
|
||||
fStringLen := 0;
|
||||
end;
|
||||
if (ToHash<=fLineLen) and IsUnderScoreOrNumberChar[fLine[ToHash]] then
|
||||
inc(ToHash);
|
||||
fStringLen := ToHash - fToIdent;
|
||||
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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user