fixed find declaration of with A,B do C; statements

git-svn-id: trunk@4345 -

components/codetools/customcodetool.pas

@@ -1935,6 +1935,9 @@ function TCustomCodeTool.FindDeepestNodeAtPos(StartNode: TCodeTreeNode;
     SaveRaiseException(ctsNoNodeFoundAtCursor);
   end;
   
+var
+  ChildNode: TCodeTreeNode;
+  Brother: TCodeTreeNode;
 begin
   if StartNode<>nil then begin
 //writeln('SearchInNode ',NodeDescriptionAsString(ANode.Desc),
@@ -1943,14 +1946,20 @@ begin
     if (StartNode.StartPos<=P)
     and ((StartNode.EndPos>P) or (StartNode.EndPos<1)) then begin
       // StartNode contains P
+      Result:=StartNode;
       // -> search for a child that contains P
-      Result:=FindDeepestNodeAtPos(StartNode.FirstChild,P,false);
-      if Result=nil then begin
-        // no child found -> search in nextbrothers that contains P
-        while (StartNode.NextBrother<>nil)
-        and (StartNode.NextBrother.StartPos<=P) do
-          StartNode:=StartNode.NextBrother;
-        Result:=StartNode;
+      Brother:=StartNode;
+      while (Brother<>nil)
+      and (Brother.StartPos<=P) do begin
+        // brother also contains P
+        if Brother.FirstChild<>nil then begin
+          ChildNode:=FindDeepestNodeAtPos(Brother.FirstChild,P,false);
+          if ChildNode<>nil then begin
+            Result:=ChildNode;
+            exit;
+          end;
+        end;
+        Brother:=Brother.NextBrother;
       end;
     end else
       // search in next node

components/codetools/finddeclarationtool.pas

@@ -59,6 +59,7 @@ interface
 { $DEFINE ShowSearchPaths}
 { $DEFINE ShowTriedFiles}
 { $DEFINE ShowTriedContexts}
+{ $DEFINE ShowTriedBaseContexts}
 { $DEFINE ShowTriedParentContexts}
 { $DEFINE ShowTriedIdentifiers}
 { $DEFINE ShowTriedUnits}
@@ -967,7 +968,7 @@ begin
       // raise exception
       FindDeepestNodeAtPos(CleanCursorPos,true);
     {$IFDEF CTDEBUG}
-    writeln('TFindDeclarationTool.FindDeclaration D CursorNode=',NodeDescriptionAsString(CursorNode.Desc));
+    writeln('TFindDeclarationTool.FindDeclaration D CursorNode=',NodeDescriptionAsString(CursorNode.Desc),' HasChilds=',CursorNode.FirstChild<>nil);
     {$ENDIF}
     if (not IsDirtySrcValid)
     and (CursorNode.Desc=ctnUsesSection) then begin
@@ -1909,7 +1910,10 @@ var
           // -> there is no prior context accessible any more
           // -> identifier not found
           {$IFDEF ShowTriedContexts}
-          writeln('[TFindDeclarationTool.FindIdentifierInContext] no prior node accessible   ContextNode=',ContextNode.DescAsString);
+          writeln('[TFindDeclarationTool.FindIdentifierInContext] no prior node accessible ',
+          ' ContextNode=',ContextNode.DescAsString,
+          ' "',StringToPascalConst(copy(Src,ContextNode.StartPos,15)),'"'
+          );
           {$ENDIF}
           ContextNode:=nil;
           Result:=false;
@@ -1929,6 +1933,7 @@ var
 
       if (ContextNode.Desc in [ctnClass,ctnClassInterface])
       and (fdfSearchInAncestors in Params.Flags) then begin
+        // after searching in a class definiton, search in its ancestors
 
         // ToDo: check for circles in ancestors
         
@@ -1972,7 +1977,13 @@ var
             // check if StartContextNode is covered by the ContextNode
             // a WithVariable ranges from the start of its expression
             // to the end of the with statement
-            if StartContextNode.StartPos<ContextNode.EndPos then break;
+            {$IFDEF ShowExprEval}
+            writeln('SearchNextNode WithVar StartContextNode.StartPos=',StartContextNode.StartPos,
+              ' ContextNode=',ContextNode.StartPos,'-',ContextNode.EndPos,
+              ' WithStart="',StringToPascalConst(copy(Src,ContextNode.StartPos,15)),'"');
+            {$ENDIF}
+            if (StartContextNode.StartPos>=ContextNode.StartPos)
+            and (StartContextNode.StartPos<ContextNode.EndPos) then break;
             { ELSE: this with statement does not cover the startcontext
              -> skip it
              for example:
@@ -2055,7 +2066,7 @@ begin
   {$IFDEF ShowTriedContexts}
   writeln('[TFindDeclarationTool.FindIdentifierInContext] Start Ident=',
   '"',GetIdentifier(Params.Identifier),'"',
-  ' Context="',ContextNode.DescAsString,'" "',copy(Src,ContextNode.StartPos,20),'"',
+  ' Context="',ContextNode.DescAsString,'" "',StringToPascalConst(copy(Src,ContextNode.StartPos,20)),'"',
   ' File="',ExtractFilename(MainFilename)+'"',
   ' Flags=[',FindDeclarationFlagsAsString(Params.Flags),']'
   );
@@ -2335,7 +2346,7 @@ begin
       end;
       AddNodeToStack(@NodeStack,Result.Node);
 
-      {$IFDEF ShowTriedContexts}
+      {$IFDEF ShowTriedBaseContexts}
       writeln('[TFindDeclarationTool.FindBaseTypeOfNode] LOOP Result=',Result.Node.DescAsString,' ',HexStr(Cardinal(Result.Node),8));
       writeln('  Flags=[',FindDeclarationFlagsAsString(Params.Flags),']');
       {$ENDIF}
@@ -2352,7 +2363,7 @@ begin
       begin
         // this is a forward defined class
         // -> search the real class
-        {$IFDEF ShowTriedContexts}
+        {$IFDEF ShowTriedBaseContexts}
         writeln('[TFindDeclarationTool.FindBaseTypeOfNode] Class is forward');
         {$ENDIF}
 
@@ -2865,8 +2876,9 @@ var
   OldInput: TFindDeclarationInput;
 begin
   {$IFDEF ShowExprEval}
-  writeln('[TFindDeclarationTool.FindIdentifierInWithVarContext] ',
-  '"',GetIdentifier(Params.Identifier),'"'
+  writeln('[TFindDeclarationTool.FindIdentifierInWithVarContext] Ident=',
+  '"',GetIdentifier(Params.Identifier),'"',
+  ' WithStart=',StringToPascalConst(copy(Src,WithVarNode.StartPos,15))
   );
   {$ENDIF}
   Result:=false;

lcl/graphics.pp

@@ -710,6 +710,7 @@ type
     function GetScanline(Row: Integer): Pointer;
     procedure SetHandleType(Value: TBitmapHandleType); virtual;
     procedure SetPixelFormat(const AValue: TPixelFormat);
+    procedure UpdatePixelFormat;
   protected
     procedure Changed(Sender: TObject); override;
     procedure Changing(Sender: TObject); virtual;
@@ -1029,6 +1030,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.73  2003/06/30 16:31:04  mattias
+  fixed find declaration of with A,B do C; statements
+
   Revision 1.72  2003/06/30 14:58:29  mattias
   implemented multi file add to package editor
 

lcl/include/bitmap.inc

@@ -163,6 +163,26 @@ begin
   writeln('WARNING: TBitmap.SetPixelFormat not implemented');
 end;
 
+procedure TBitmap.UpdatePixelFormat;
+begin
+  FPixelFormat := pfCustom;
+  if HandleType = bmDDB then
+    FPixelFormat := pfDevice
+  else
+    with FImage.FDIB, dsbmih do
+      case biBitCount of
+        1: FPixelFormat := pf1Bit;
+        4: FPixelFormat := pf4Bit;
+        8: FPixelFormat := pf8Bit;
+       16: case biCompression of
+             BI_RGB : FPixelFormat := pf15Bit;
+             BI_BITFIELDS: if dsBitFields[1] = $7E0 then FPixelFormat := pf16Bit;
+           end;
+       24: FPixelFormat := pf24Bit;
+       32: if biCompression = BI_RGB then FPixelFormat := pf32Bit;
+      end;
+end;
+
 procedure TBitmap.Changed(Sender: TObject);
 begin
   //FMaskBitsValid := False;
@@ -711,6 +731,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.35  2003/06/30 16:31:04  mattias
+  fixed find declaration of with A,B do C; statements
+
   Revision 1.34  2003/06/30 15:13:21  mattias
   fixed releasing bitmap handle