paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-18 09:29:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: fixes for Delphi compataibility

Browse Source 
git-svn-id: trunk@1492 -
This commit is contained in:
lazarus 2002-03-09 16:46:33 +00:00
parent ba01ab7df2
commit e14d49fb6c
3 changed files with 67 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
components/codetools/codecompletiontool.pas
View File

@ -1083,7 +1083,8 @@ writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Gather existing method
if (ProcCode='') then begin
ANode:=ANodeExt.Node;
if (ANode<>nil) and (ANode.Desc=ctnProcedure) then begin
ProcCode:=ExtractProcHead(ANode,[phpWithStart,phpAddClassname,
ProcCode:=ExtractProcHead(ANode,[phpWithStart,
phpWithoutClassKeyword,phpAddClassname,
phpWithParameterNames,phpWithResultType,phpWithVarModifiers]);
end;
end;
@ -1299,8 +1300,9 @@ writeln('TCodeCompletionCodeTool.CompleteCode Body not found -> create it ... ')
end;
// build nice proc
ProcCode:=ExtractProcHead(ProcNode,[phpWithStart,phpWithVarModifiers,
phpWithParameterNames,phpWithResultType,phpWithComments]);
ProcCode:=ExtractProcHead(ProcNode,[phpWithStart,phpWithoutClassKeyword,
phpWithVarModifiers,phpWithParameterNames,phpWithResultType,
phpWithComments]);
if ProcCode='' then
RaiseException('unable to reparse proc node');
ProcCode:=SourceChangeCache.BeautifyCodeOptions.BeautifyProc(ProcCode,

61
components/codetools/pascalparsertool.pas
View File

@ -347,6 +347,7 @@ begin
Add('TYPE',{$ifdef FPC}@{$endif}KeyWordFuncType);
Add('VAR',{$ifdef FPC}@{$endif}KeyWordFuncVar);
Add('THREADVAR',{$ifdef FPC}@{$endif}KeyWordFuncVar);
Add('CONST',{$ifdef FPC}@{$endif}KeyWordFuncConst);
Add('RESOURCESTRING',{$ifdef FPC}@{$endif}KeyWordFuncResourceString);
Add('LABEL',{$ifdef FPC}@{$endif}KeyWordFuncLabel);
@ -2429,7 +2430,7 @@ function TPascalParserTool.KeyWordFuncTypeProc: boolean;
function(ParmList):SimpleType of object;
procedure; cdecl; popstack; register; pascal; stdcall;
}
var IsFunction, SemicolonFound: boolean;
var IsFunction, EqualFound: boolean;
begin
IsFunction:=UpAtomIs('FUNCTION');
CreateChildNode;
@ -2460,38 +2461,38 @@ begin
end else begin
if AtomIsChar(';') then begin
ReadNextAtom;
SemicolonFound:=true;
end else begin
SemicolonFound:=false;
EqualFound:=false;
end else if AtomIsChar('=') then begin
EqualFound:=true;
end;
// read modifiers
repeat
if not IsKeyWordProcedureTypeSpecifier.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then
begin
if not SemicolonFound then
RaiseException('; expected, but '+GetAtom+' found');
UndoReadNextAtom;
break;
end else begin
if not ReadNextAtomIsChar(';') then begin
if Scanner.CompilerMode<>cmDelphi then begin
if not EqualFound then begin
// read modifiers
repeat
if (not IsKeyWordProcedureTypeSpecifier.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)) then
begin
UndoReadNextAtom;
if (not AtomIsChar(';')) and (Scanner.CompilerMode<>cmDelphi) then
RaiseException('; expected, but '+GetAtom+' found');
end else begin
// delphi allows proc modifiers without semicolons
if not IsKeyWordProcedureTypeSpecifier.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then
begin
RaiseException('; expected, but '+GetAtom+' found');
end;
UndoReadNextAtom;
end;
break;
end else begin
SemicolonFound:=true;
if not ReadNextAtomIsChar(';') then begin
if Scanner.CompilerMode<>cmDelphi then begin
RaiseException('; expected, but '+GetAtom+' found');
end else begin
// delphi allows proc modifiers without semicolons
if not IsKeyWordProcedureTypeSpecifier.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then
begin
RaiseException('; expected, but '+GetAtom+' found');
end;
UndoReadNextAtom;
end;
end;
end;
end;
ReadNextAtom;
until false;
ReadNextAtom;
until false;
end;
end;
CurNode.EndPos:=CurPos.StartPos;
EndChildNode;
@ -2560,8 +2561,6 @@ end;
function TPascalParserTool.KeyWordFuncTypePointer: boolean;
// '^Identfier'
begin
if not (LastAtomIs(0,'=') or LastAtomIs(0,':')) then
RaiseException('identifier expected, but ^ found');
CreateChildNode;
CurNode.Desc:=ctnPointerType;
ReadNextAtom;

40
lcl/include/picture.inc
View File

@ -142,7 +142,7 @@ constructor TPicture.Create;
begin
inherited Create;
GetFileFormats;
//GetClipboardFormats;
GetClipboardFormats;
end;
destructor TPicture.Destroy;
@ -180,12 +180,14 @@ end;
function TPicture.GetPixmap: TPixmap;
begin
Result:=nil;
ForceType(TPixmap);
Result := TPixmap(Graphic);
end;
function TPicture.GetIcon: TIcon;
begin
Result:=nil;
ForceType(TIcon);
Result := TIcon(Graphic);
end;
procedure TPicture.SetBitmap(Value: TBitmap);
@ -225,7 +227,7 @@ begin
end;
end;
{ Based on the extension of Filename, create the cooresponding TGraphic class
{ Based on the extension of Filename, create the corresponding TGraphic class
and call its LoadFromFile method. }
procedure TPicture.LoadFromFile(const Filename: string);
@ -233,20 +235,24 @@ var
Ext: string;
NewGraphic: TGraphic;
GraphicClass: TGraphicClass;
ok: boolean;
begin
Ext := ExtractFileExt(Filename);
Delete(Ext, 1, 1);
System.Delete(Ext, 1, 1); // delete '.'
GraphicClass := GetFileFormats.FindExt(Ext);
if GraphicClass = nil then
raise EInvalidGraphic.CreateFmt('Unknown picture extension', [Ext]);
NewGraphic := GraphicClass.Create;
ok:=false;
try
NewGraphic.OnProgress := @Progress;
NewGraphic.LoadFromFile(Filename);
except
NewGraphic.Free;
raise;
ok:=true;
finally
// this try..finally construction will in case of an exception
// not alter the error backtrace output
if not ok then NewGraphic.Free;
end;
FGraphic.Free;
FGraphic := NewGraphic;
@ -260,8 +266,26 @@ begin
end;
procedure TPicture.LoadFromClipboardFormat(FormatID: TClipboardFormat);
var
NewGraphic: TGraphic;
GraphicClass: TGraphicClass;
begin
GraphicClass := ClipboardFormats.FindFormat(FormatID);
if GraphicClass = nil then
InvalidGraphic(@SUnknownClipboardFormat);
NewGraphic := GraphicClass.Create;
try
NewGraphic.OnProgress := Progress;
NewGraphic.LoadFromClipboardFormat(AFormat, AData, APalette);
except
NewGraphic.Free;
raise;
end;
FGraphic.Free;
FGraphic := NewGraphic;
FGraphic.OnChange := Changed;
Changed(Self);
end;
procedure TPicture.SaveToClipboardFormat(FormatID: TClipboardFormat);