fixed focusing in gtklist

git-svn-id: trunk@8568 -

lcl/interfaces/gtk/gtklistsl.inc

@@ -732,9 +732,16 @@ end;
 
  ------------------------------------------------------------------------------}
 procedure TGtkListStringList.Clear;
+{$IFDEF DebugLCLComponents}
+var i: integer;
+{$ENDIF}
 begin
   BeginUpdate;
   RemoveAllCallbacks;
+  {$IFDEF DebugLCLComponents}
+  for i:=0 to FCachedCount-1 do
+    DebugGtkWidgets.MarkDestroyed(FCachedItems[i]);
+  {$ENDIF}
   Include(FStates,glsItemCacheNeedsUpdate);
   CheckForInvalidFocus;
   gtk_list_clear_items(FGtkList, 0, Count);

lcl/interfaces/gtk/gtkwinapi.inc

@@ -8284,6 +8284,7 @@ function TGtkWidgetSet.SetFocus(hWnd: HWND): HWND;
     WinWidgetInfo: PWinWidgetInfo;
     ImplWidget: PGtkWidget;
     GList: PGlist;
+    LastFocusWidget: PGtkWidget;
   begin
     // Default to the widget, try to find other
     Result := AWidget;
@@ -8318,11 +8319,15 @@ function TGtkWidgetSet.SetFocus(hWnd: HWND): HWND;
       if not (selection_mode(PGtkList(ImplWidget)^) in [GTK_SELECTION_SINGLE, GTK_SELECTION_BROWSE])
       and (PGtkList(ImplWidget)^.last_focus_child <> nil)
       then begin
-        Result := PGtkList(ImplWidget)^.last_focus_child;
-        {$IfDef VerboseFocus}
-        DebugLn('  E.1 using last_focus_child');
-        {$EndIf}
-        Exit;
+        LastFocusWidget:=PGtkList(ImplWidget)^.last_focus_child;
+        if g_list_find(PGtkList(ImplWidget)^.selection,LastFocusWidget)<>nil
+        then begin
+          Result := PGtkList(ImplWidget)^.last_focus_child;
+          {$IfDef VerboseFocus}
+          DebugLn('  E.1 using last_focus_child');
+          {$EndIf}
+          Exit;
+        end;
       end;
 
       // If there is a selection, try the first
@@ -8442,6 +8447,7 @@ begin
         {$IfDef VerboseFocus}
         DebugLn('  H SETTING NewFocusWidget=',dbgs(NewFocusWidget),' ',DbgSName(GetNearestLCLObject(NewFocusWidget)));
         {$EndIf}
+        //DebugLn('TGtkWidgetSet.SetFocus TopLevel[',DebugGtkWidgets.GetInfo(TopLevel,false),'] NewFocusWidget=[',DebugGtkWidgets.GetInfo(NewFocusWidget,false),']');
         gtk_window_set_focus(PGtkWindow(TopLevel),NewFocusWidget);
         {$IfDef VerboseFocus}
         DebugLn('  I NewTopLevel FocusWidget=',DbgS(PGtkWindow(TopLevel)^.Focus_Widget),' Success=',dbgs(PGtkWindow(TopLevel)^.Focus_Widget=NewFocusWidget));

lcl/lclproc.pas

@@ -58,6 +58,7 @@ type
   end;
   
 type
+  TStackTracePointers = array of Pointer;
 
   { TDebugLCLItemInfo }
 
@@ -66,9 +67,10 @@ type
     Item: Pointer;
     IsDestroyed: boolean;
     Info: string;
-    CreationStack: string; // stack trace at creationg
-    DestructionStack: string;// stack trace at destruction
-    function AsString: string;
+    CreationStack: TStackTracePointers; // stack trace at creationg
+    DestructionStack: TStackTracePointers;// stack trace at destruction
+    function AsString(WithStackTraces: boolean): string;
+    destructor Destroy; override;
   end;
   
   { TDebugLCLItems }
@@ -84,6 +86,7 @@ type
     function IsDestroyed(p: Pointer): boolean;
     function MarkCreated(p: Pointer; const InfoText: string): TDebugLCLItemInfo;
     procedure MarkDestroyed(p: Pointer);
+    function GetInfo(p: Pointer; WithStackTraces: boolean): string;
   end;
   
   TLineInfoCacheItem = record
@@ -160,6 +163,9 @@ procedure RaiseGDBException(const Msg: string);
 procedure DumpExceptionBackTrace;
 procedure DumpStack;
 function GetStackTrace(UseCache: boolean): string;
+procedure GetStackTracePointers(var AStack: TStackTracePointers);
+function StackTraceAsString(const AStack: TStackTracePointers;
+                            UseCache: boolean): string;
 function GetLineInfo(Addr: Pointer; UseCache: boolean): string;
 
 procedure DebugLn(const S: String; Args: array of const);
@@ -763,6 +769,50 @@ begin
   end;
 end;
 
+procedure GetStackTracePointers(var AStack: TStackTracePointers);
+var
+  Depth: Integer;
+  bp: Pointer;
+  oldbp: Pointer;
+begin
+  // get stack depth
+  Depth:=0;
+  bp:=get_caller_frame(get_frame);
+  while bp<>nil do begin
+    inc(Depth);
+    oldbp:=bp;
+    bp:=get_caller_frame(bp);
+    if (bp<=oldbp) or (bp>(StackBottom + StackLength)) then
+      bp:=nil;
+  end;
+  SetLength(AStack,Depth);
+  if Depth>0 then begin
+    Depth:=0;
+    bp:=get_caller_frame(get_frame);
+    while bp<>nil do begin
+      AStack[Depth]:=get_caller_addr(bp);
+      inc(Depth);
+      oldbp:=bp;
+      bp:=get_caller_frame(bp);
+      if (bp<=oldbp) or (bp>(StackBottom + StackLength)) then
+        bp:=nil;
+    end;
+  end;
+end;
+
+function StackTraceAsString(const AStack: TStackTracePointers;
+  UseCache: boolean): string;
+var
+  i: Integer;
+  CurAddress: String;
+begin
+  Result:='';
+  for i:=0 to length(AStack)-1 do begin
+    CurAddress:=GetLineInfo(AStack[i],UseCache);
+    Result:=Result+CurAddress+LineEnding;
+  end;
+end;
+
 function GetLineInfo(Addr: Pointer; UseCache: boolean): string;
 var
   ANode: TAvgLvlTreeNode;
@@ -2550,7 +2600,7 @@ var
   procedure RaiseDoubleDestroyed;
   begin
     debugLn('TDebugLCLItems.MarkDestroyed Double destroyed:');
-    debugln(Info.AsString);
+    debugln(Info.AsString(true));
     debugln('Now:');
     DebugLn(GetStackTrace(true));
     RaiseGDBException('RaiseDoubleDestroyed');
@@ -2563,7 +2613,18 @@ begin
   if Info.IsDestroyed then
     RaiseDoubleDestroyed;
   Info.IsDestroyed:=true;
-  Info.DestructionStack:=GetStackTrace(true);
+  GetStackTracePointers(Info.DestructionStack);
+end;
+
+function TDebugLCLItems.GetInfo(p: Pointer; WithStackTraces: boolean): string;
+var
+  Info: TDebugLCLItemInfo;
+begin
+  Info:=FindInfo(p,false);
+  if Info<>nil then
+    Result:=Info.AsString(WithStackTraces)
+  else
+    Result:='';
 end;
 
 function TDebugLCLItems.MarkCreated(p: Pointer;
@@ -2574,7 +2635,7 @@ var
   procedure RaiseDoubleCreated;
   begin
     debugLn('TDebugLCLItems.MarkCreated old:');
-    debugln(Info.AsString);
+    debugln(Info.AsString(true));
     debugln(' New=',dbgs(p),' InfoText="',InfoText,'"');
     DebugLn(GetStackTrace(true));
     RaiseGDBException('RaiseDoubleCreated');
@@ -2591,22 +2652,31 @@ begin
   end;
   Info.IsDestroyed:=false;
   Info.Info:=InfoText;
-  Info.CreationStack:=GetStackTrace(true);
-  Info.DestructionStack:='';
+  GetStackTracePointers(Info.CreationStack);
+  SetLength(Info.DestructionStack,0);
   Result:=Info;
 end;
 
 { TDebugLCLItemInfo }
 
-function TDebugLCLItemInfo.AsString: string;
+function TDebugLCLItemInfo.AsString(WithStackTraces: boolean): string;
 begin
   Result:='Item='+Dbgs(Item)+LineEnding
-          +'Info="'+DbgStr(Info)+LineEnding
-          +'Creation:'+LineEnding
-          +CreationStack;
-  if IsDestroyed then
-    Result:=Result+'Destroyed:'+LineEnding
-            +DestructionStack
+          +'Info="'+DbgStr(Info)+LineEnding;
+  if WithStackTraces then
+    Result:=Result+'Creation:'+LineEnding+StackTraceAsString(CreationStack,true);
+  if IsDestroyed then begin
+    Result:=Result+'Destroyed:'+LineEnding;
+    if WithStackTraces then
+      Result:=Result+StackTraceAsString(DestructionStack,true);
+  end;
+end;
+
+destructor TDebugLCLItemInfo.Destroy;
+begin
+  SetLength(CreationStack,0);
+  SetLength(DestructionStack,0);
+  inherited Destroy;
 end;
 
 initialization