implemented copy-all from call stack view (issue #1511)

git-svn-id: trunk@8476 -

debugger/callstackdlg.lfm

@@ -1,10 +1,12 @@
 object CallStackDlg: TCallStackDlg
+  ActiveControl = lvCallStack
   Caption = 'CallStack'
   ClientHeight = 200
   ClientWidth = 500
+  PixelsPerInch = 96
   Visible = True
-  HorzScrollBar.Page = 501
+  HorzScrollBar.Page = 499
-  VertScrollBar.Page = 201
+  VertScrollBar.Page = 199
   Left = 843
   Height = 200
   Top = 202
@@ -14,21 +16,16 @@ object CallStackDlg: TCallStackDlg
     Columns = <    
       item
         Caption = 'Source'
-        ImageIndex = -1
-        Visible = True
         Width = 150
       end    
       item
         Caption = 'Line'
-        ImageIndex = -1
-        Visible = True
-        Width = 50
       end    
       item
         Caption = 'Function'
-        ImageIndex = -1
-        Visible = True
       end>
+    PopupMenu = mnuPopup
+    TabOrder = 0
     ViewStyle = vsReport
     OnDblClick = lvCallStackDBLCLICK
     Height = 200
@@ -48,5 +45,10 @@ object CallStackDlg: TCallStackDlg
     object popSetAsCurrent: TMenuItem
       Caption = 'Set as current'
     end
+    object popCopyAll: TMenuItem
+      Caption = 'Copy all'
+      ShortCut = 16451
+      OnClick = popCopyAllClick
+    end
   end
 end

debugger/callstackdlg.lrs

@@ -1,17 +1,18 @@
 { This is an automatically generated lazarus resource file }
 
 LazarusResources.Add('TCallStackDlg','FORMDATA',[
-  'TPF0'#13'TCallStackDlg'#12'CallStackDlg'#7'Caption'#6#9'CallStack'#12'Client'
+  'TPF0'#13'TCallStackDlg'#12'CallStackDlg'#13'ActiveControl'#7#11'lvCallStack'
-  +'Height'#3#200#0#11'ClientWidth'#3#244#1#7'Visible'#9#18'HorzScrollBar.Page'
+  +#7'Caption'#6#9'CallStack'#12'ClientHeight'#3#200#0#11'ClientWidth'#3#244#1
-  +#3#245#1#18'VertScrollBar.Page'#3#201#0#4'Left'#3'K'#3#6'Height'#3#200#0#3'T'
+  +#13'PixelsPerInch'#2'`'#7'Visible'#9#18'HorzScrollBar.Page'#3#243#1#18'VertS'
-  +'op'#3#202#0#5'Width'#3#244#1#0#9'TListView'#11'lvCallStack'#5'Align'#7#8'al'
+  +'crollBar.Page'#3#199#0#4'Left'#3'K'#3#6'Height'#3#200#0#3'Top'#3#202#0#5'Wi'
-  +'Client'#7'Columns'#14#1#7'Caption'#6#6'Source'#10'ImageIndex'#2#255#7'Visib'
+  +'dth'#3#244#1#0#9'TListView'#11'lvCallStack'#5'Align'#7#8'alClient'#7'Column'
-  +'le'#9#5'Width'#3#150#0#0#1#7'Caption'#6#4'Line'#10'ImageIndex'#2#255#7'Visi'
+  +'s'#14#1#7'Caption'#6#6'Source'#5'Width'#3#150#0#0#1#7'Caption'#6#4'Line'#0#1
-  +'ble'#9#5'Width'#2'2'#0#1#7'Caption'#6#8'Function'#10'ImageIndex'#2#255#7'Vi'
+  +#7'Caption'#6#8'Function'#0#0#9'PopupMenu'#7#8'mnuPopup'#8'TabOrder'#2#0#9'V'
-  +'sible'#9#0#0#9'ViewStyle'#7#8'vsReport'#10'OnDblClick'#7#19'lvCallStackDBLC'
+  +'iewStyle'#7#8'vsReport'#10'OnDblClick'#7#19'lvCallStackDBLCLICK'#6'Height'#3
-  +'LICK'#6'Height'#3#200#0#5'Width'#3#244#1#0#0#10'TPopupMenu'#8'mnuPopup'#4'l'
+  +#200#0#5'Width'#3#244#1#0#0#10'TPopupMenu'#8'mnuPopup'#4'left'#2'B'#3'top'#2
-  +'eft'#2'B'#3'top'#2'X'#0#9'TMenuItem'#7'popShow'#7'Caption'#6#4'Show'#7'Defa'
+  +'X'#0#9'TMenuItem'#7'popShow'#7'Caption'#6#4'Show'#7'Default'#9#7'OnClick'#7
-  +'ult'#9#7'OnClick'#7#12'popShowClick'#0#0#9'TMenuItem'#2'N1'#7'Caption'#6#1
+  +#12'popShowClick'#0#0#9'TMenuItem'#2'N1'#7'Caption'#6#1'-'#0#0#9'TMenuItem'
-  +'-'#0#0#9'TMenuItem'#15'popSetAsCurrent'#7'Caption'#6#14'Set as current'#0#0
+  +#15'popSetAsCurrent'#7'Caption'#6#14'Set as current'#0#0#9'TMenuItem'#10'pop'
-  +#0#0
+  +'CopyAll'#7'Caption'#6#8'Copy all'#8'ShortCut'#3'C@'#7'OnClick'#7#15'popCopy'
+  +'AllClick'#0#0#0#0
 ]);

debugger/callstackdlg.pp

@@ -37,23 +37,30 @@ interface
 
 uses
   LResources, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
-  ComCtrls, Debugger, DebuggerDlg, Menus;
+  ComCtrls, Debugger, DebuggerDlg, Menus, ClipBrd;
 
 type
+
+  { TCallStackDlg }
+
   TCallStackDlg = class(TDebuggerDlg)
     lvCallStack: TListView;
+    popCopyAll: TMenuItem;
     N1: TMenuItem;
     popSetAsCurrent: TMenuItem;
     popShow: TMenuItem;
     mnuPopup: TPopupMenu;
     procedure lvCallStackDBLCLICK(Sender: TObject);
+    procedure popCopyAllClick(Sender: TObject);
     procedure popShowClick(Sender: TObject);
   private
     FCallStack: TIDECallStack;
     FCallStackNotification: TIDECallStackNotification;
     procedure CallStackChanged(Sender: TObject);
     procedure SetCallStack(const AValue: TIDECallStack);
+    function GetFunction(const Entry: TCallStackEntry): string;
     procedure JumpToSource;
+    procedure CopyToClipBoard;
   protected
     procedure DoBeginUpdate; override;
     procedure DoEndUpdate; override;
@@ -79,9 +86,8 @@ end;
 
 procedure TCallStackDlg.CallStackChanged(Sender: TObject);
 var
-  n, m: Integer;                               
+  n: Integer;
   Item: TListItem;
-  S: String;   
   Entry: TCallStackEntry;
 begin       
   BeginUpdate;
@@ -111,16 +117,7 @@ begin
       Entry := CallStack.Entries[n];
       Item.Caption := Entry.Source;
       Item.SubItems[0] := IntToStr(Entry.Line);
-      S := '';
+      Item.SubItems[1] := GetFunction(Entry);
-      for m := 0 to Entry.ArgumentCount - 1 do
-      begin
-        if S <> ''
-        then S := S + ', ';
-        S := S + Entry.ArgumentValues[m];
-      end;
-      if S <> ''
-      then S := '(' + S + ')';
-      Item.SubItems[1] := Entry.FunctionName + S;
     end;
     
   finally
@@ -159,11 +156,40 @@ begin
   DoJumpToCodePos(Filename,Line,0);
 end;
 
+procedure TCallStackDlg.CopyToClipBoard;
+var
+  n: integer;
+  Entry: TCallStackEntry;
+  EntryList: TStringList;
+begin
+  Clipboard.Clear;
+  
+  if (CallStack=nil) or (CallStack.Count=0) then exit;
+  
+  EntryList:=TStringList.Create;
+  try
+    EntryList.Capacity:=CallStack.Count;
+    for n:= 0 to CallStack.Count-1 do begin
+      Entry:=CallStack.Entries[n];
+      EntryList.Add(format('#%d %s at %s:%d',
+        [n, GetFunction(Entry), Entry.Source, Entry.Line]));
+    end;
+    ClipBoard.AsText := EntryList.Text;
+  finally
+    EntryList.Free;
+  end;
+end;
+
 procedure TCallStackDlg.lvCallStackDBLCLICK(Sender: TObject);
 begin
   JumpToSource;
 end;
 
+procedure TCallStackDlg.popCopyAllClick(Sender: TObject);
+begin
+  CopyToClipBoard;
+end;
+
 procedure TCallStackDlg.popShowClick(Sender: TObject);
 begin
   JumpToSource;
@@ -193,6 +219,23 @@ begin
   end;
 end;
 
+function TCallStackDlg.GetFunction(const Entry: TCallStackEntry): string;
+var
+  S: String;
+  m: Integer;
+begin
+  S := '';
+  for m := 0 to Entry.ArgumentCount - 1 do
+  begin
+    if S <> '' then
+      S := S + ', ';
+    S := S + Entry.ArgumentValues[m];
+  end;
+  if S <> '' then
+    S := '(' + S + ')';
+  Result := Entry.FunctionName + S;
+end;
+
 initialization
   {$I callstackdlg.lrs}