MG: fixes for Delphi compataibility

git-svn-id: trunk@1492 -

components/codetools/codecompletiontool.pas

@@ -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,
+      ProcCode:=ExtractProcHead(ProcNode,[phpWithStart,phpWithoutClassKeyword,
-                  phpWithParameterNames,phpWithResultType,phpWithComments]);
+                  phpWithVarModifiers,phpWithParameterNames,phpWithResultType,
+                  phpWithComments]);
       if ProcCode='' then 
         RaiseException('unable to reparse proc node');
       ProcCode:=SourceChangeCache.BeautifyCodeOptions.BeautifyProc(ProcCode,

components/codetools/pascalparsertool.pas

@@ -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;
+      EqualFound:=false;
-    end else begin
+    end else if AtomIsChar('=') then begin
-      SemicolonFound:=false;
+      EqualFound:=true;
     end;
-    // read modifiers
+    if not EqualFound then begin
-    repeat
+      // read modifiers
-      if not IsKeyWordProcedureTypeSpecifier.DoItUpperCase(UpperSrc,
+      repeat
-        CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then
+        if (not IsKeyWordProcedureTypeSpecifier.DoItUpperCase(UpperSrc,
-      begin
+          CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)) then
-        if not SemicolonFound then
+        begin
-          RaiseException('; expected, but '+GetAtom+' found');
+          UndoReadNextAtom;
-        UndoReadNextAtom;
+          if (not AtomIsChar(';')) and (Scanner.CompilerMode<>cmDelphi) then
-        break;
-      end else begin
-        if not ReadNextAtomIsChar(';') then begin
-          if Scanner.CompilerMode<>cmDelphi then begin
             RaiseException('; expected, but '+GetAtom+' found');
-          end else begin
+          break;
-            // 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 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;
-      ReadNextAtom;
+      until false;
-    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;

lcl/include/picture.inc

@@ -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
+    ok:=true;
-    NewGraphic.Free;
+  finally
-    raise;
+    // 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);