LeakView: Allow paste from clipboard; Allow parsing exception trace too

git-svn-id: trunk@24014 -

components/leakview/heaptrcview.lfm

@@ -13,15 +13,15 @@ object HeapTrcViewForm: THeapTrcViewForm
   LCLVersion = '0.9.29'
   object lblTrcFile: TLabel
     Left = 16
-    Height = 18
+    Height = 16
     Top = 16
-    Width = 45
+    Width = 37
     Caption = '.trc file'
     ParentColor = False
   end
   object edtTrcFileName: TEdit
     Left = 72
-    Height = 22
+    Height = 23
     Top = 16
     Width = 311
     Anchors = [akTop, akLeft, akRight]
@@ -29,19 +29,19 @@ object HeapTrcViewForm: THeapTrcViewForm
   end
   object btnUpdate: TButton
     Left = 16
-    Height = 20
+    Height = 25
     Top = 54
-    Width = 70
+    Width = 64
     AutoSize = True
     Caption = 'Update'
     OnClick = btnUpdateClick
     TabOrder = 1
   end
   object chkStayOnTop: TCheckBox
-    Left = 335
+    Left = 347
-    Height = 18
+    Height = 19
     Top = 56
-    Width = 92
+    Width = 80
     Anchors = [akTop, akRight]
     Caption = 'Stay on top'
     OnChange = chkStayOnTopChange
@@ -59,10 +59,10 @@ object HeapTrcViewForm: THeapTrcViewForm
     TabOrder = 3
   end
   object chkUseRaw: TCheckBox
-    Left = 99
+    Left = 240
-    Height = 18
+    Height = 19
     Top = 56
-    Width = 107
+    Width = 92
     Caption = 'Raw leak data'
     Checked = True
     OnChange = chkUseRawChange
@@ -85,7 +85,7 @@ object HeapTrcViewForm: THeapTrcViewForm
       Top = 0
       Width = 415
       Align = alClient
-      DefaultItemHeight = 19
+      DefaultItemHeight = 17
       ReadOnly = True
       TabOrder = 0
       OnDblClick = trvTraceInfoDblClick
@@ -111,4 +111,14 @@ object HeapTrcViewForm: THeapTrcViewForm
       ResizeAnchor = akBottom
     end
   end
+  object btnClipboard: TButton
+    Left = 104
+    Height = 25
+    Top = 54
+    Width = 109
+    AutoSize = True
+    Caption = 'Paste Clipboard'
+    OnClick = btnClipboardClick
+    TabOrder = 6
+  end
 end

components/leakview/heaptrcview.lrs

@@ -6,31 +6,33 @@ LazarusResources.Add('THeapTrcViewForm','FORMDATA',[
   +'ption'#6#15'HeapTrcViewForm'#12'ClientHeight'#3#146#1#11'ClientWidth'#3#191
   +#1#9'FormStyle'#7#11'fsStayOnTop'#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7
   +#11'FormDestroy'#10'LCLVersion'#6#6'0.9.29'#0#6'TLabel'#10'lblTrcFile'#4'Lef'
-  +'t'#2#16#6'Height'#2#18#3'Top'#2#16#5'Width'#2'-'#7'Caption'#6#9'.trc file'
+  +'t'#2#16#6'Height'#2#16#3'Top'#2#16#5'Width'#2'%'#7'Caption'#6#9'.trc file'
   +#11'ParentColor'#8#0#0#5'TEdit'#14'edtTrcFileName'#4'Left'#2'H'#6'Height'#2
-  +#22#3'Top'#2#16#5'Width'#3'7'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0
+  +#23#3'Top'#2#16#5'Width'#3'7'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0
-  +#8'TabOrder'#2#0#0#0#7'TButton'#9'btnUpdate'#4'Left'#2#16#6'Height'#2#20#3'T'
+  +#8'TabOrder'#2#0#0#0#7'TButton'#9'btnUpdate'#4'Left'#2#16#6'Height'#2#25#3'T'
-  +'op'#2'6'#5'Width'#2'F'#8'AutoSize'#9#7'Caption'#6#6'Update'#7'OnClick'#7#14
+  +'op'#2'6'#5'Width'#2'@'#8'AutoSize'#9#7'Caption'#6#6'Update'#7'OnClick'#7#14
   +'btnUpdateClick'#8'TabOrder'#2#1#0#0#9'TCheckBox'#12'chkStayOnTop'#4'Left'#3
-  +'O'#1#6'Height'#2#18#3'Top'#2'8'#5'Width'#2'\'#7'Anchors'#11#5'akTop'#7'akRi'
+  +'['#1#6'Height'#2#19#3'Top'#2'8'#5'Width'#2'P'#7'Anchors'#11#5'akTop'#7'akRi'
   +'ght'#0#7'Caption'#6#11'Stay on top'#8'OnChange'#7#18'chkStayOnTopChange'#7
   +'OnClick'#7#17'chkStayOnTopClick'#8'TabOrder'#2#2#0#0#7'TButton'#9'btnBrowse'
   +#4'Left'#3#143#1#6'Height'#2#20#3'Top'#2#14#5'Width'#2' '#7'Anchors'#11#5'ak'
   +'Top'#7'akRight'#0#7'Caption'#6#3'...'#7'OnClick'#7#14'btnBrowseClick'#8'Tab'
-  +'Order'#2#3#0#0#9'TCheckBox'#9'chkUseRaw'#4'Left'#2'c'#6'Height'#2#18#3'Top'
+  +'Order'#2#3#0#0#9'TCheckBox'#9'chkUseRaw'#4'Left'#3#240#0#6'Height'#2#19#3'T'
-  +#2'8'#5'Width'#2'k'#7'Caption'#6#13'Raw leak data'#7'Checked'#9#8'OnChange'#7
+  +'op'#2'8'#5'Width'#2'\'#7'Caption'#6#13'Raw leak data'#7'Checked'#9#8'OnChan'
-  +#15'chkUseRawChange'#5'State'#7#9'cbChecked'#8'TabOrder'#2#4#0#0#6'TPanel'#9
+  +'ge'#7#15'chkUseRawChange'#5'State'#7#9'cbChecked'#8'TabOrder'#2#4#0#0#6'TPa'
-  +'ctrlPanel'#4'Left'#2#16#6'Height'#3#27#1#3'Top'#2'`'#5'Width'#3#159#1#7'Anc'
+  +'nel'#9'ctrlPanel'#4'Left'#2#16#6'Height'#3#27#1#3'Top'#2'`'#5'Width'#3#159#1
-  +'hors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#10'BevelOuter'#7#6'bvN'
+  +#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#10'BevelOuter'#7#6
-  +'one'#12'ClientHeight'#3#27#1#11'ClientWidth'#3#159#1#8'TabOrder'#2#5#0#9'TT'
+  +'bvNone'#12'ClientHeight'#3#27#1#11'ClientWidth'#3#159#1#8'TabOrder'#2#5#0#9
-  +'reeView'#12'trvTraceInfo'#4'Left'#2#0#6'Height'#3#197#0#3'Top'#2#0#5'Width'
+  +'TTreeView'#12'trvTraceInfo'#4'Left'#2#0#6'Height'#3#197#0#3'Top'#2#0#5'Widt'
-  +#3#159#1#5'Align'#7#8'alClient'#17'DefaultItemHeight'#2#19#8'ReadOnly'#9#8'T'
+  +'h'#3#159#1#5'Align'#7#8'alClient'#17'DefaultItemHeight'#2#17#8'ReadOnly'#9#8
-  +'abOrder'#2#0#10'OnDblClick'#7#20'trvTraceInfoDblClick'#7'Options'#11#17'tvo'
+  +'TabOrder'#2#0#10'OnDblClick'#7#20'trvTraceInfoDblClick'#7'Options'#11#17'tv'
-  +'AutoItemHeight'#16'tvoHideSelection'#21'tvoKeepCollapsedNodes'#11'tvoReadOn'
+  +'oAutoItemHeight'#16'tvoHideSelection'#21'tvoKeepCollapsedNodes'#11'tvoReadO'
-  +'ly'#14'tvoShowButtons'#12'tvoShowLines'#11'tvoShowRoot'#11'tvoToolTips'#0#0
+  +'nly'#14'tvoShowButtons'#12'tvoShowLines'#11'tvoShowRoot'#11'tvoToolTips'#0#0
   +#0#5'TMemo'#11'memoSummary'#4'Left'#2#0#6'Height'#2'Q'#3'Top'#3#202#0#5'Widt'
   +'h'#3#159#1#5'Align'#7#8'alBottom'#8'ReadOnly'#9#10'ScrollBars'#7#10'ssVerti'
   +'cal'#8'TabOrder'#2#1#0#0#9'TSplitter'#8'splitter'#6'Cursor'#7#8'crVSplit'#4
   +'Left'#2#0#6'Height'#2#5#3'Top'#3#197#0#5'Width'#3#159#1#5'Align'#7#8'alBott'
-  +'om'#12'ResizeAnchor'#7#8'akBottom'#0#0#0#0
+  +'om'#12'ResizeAnchor'#7#8'akBottom'#0#0#0#7'TButton'#12'btnClipboard'#4'Left'
+  +#2'h'#6'Height'#2#25#3'Top'#2'6'#5'Width'#2'm'#8'AutoSize'#9#7'Caption'#6#15
+  +'Paste Clipboard'#7'OnClick'#7#17'btnClipboardClick'#8'TabOrder'#2#6#0#0#0
 ]);

components/leakview/heaptrcview.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
-  StdCtrls, ComCtrls, ExtCtrls, LeakInfo, LazIDEIntf, MenuIntf, contnrs;
+  StdCtrls, ComCtrls, ExtCtrls, LeakInfo, LazIDEIntf, MenuIntf, contnrs, Clipbrd;
 
 type
   TJumpProc = procedure (Sender: TObject; const SourceName: string; Line: integer) of object;
@@ -15,6 +15,7 @@ type
   THeapTrcViewForm = class(TForm)
     btnUpdate: TButton;
     btnBrowse: TButton;
+    btnClipboard: TButton;
     chkUseRaw: TCheckBox;
     chkStayOnTop: TCheckBox;
     edtTrcFileName: TEdit;
@@ -23,6 +24,7 @@ type
     memoSummary: TMemo;
     splitter: TSplitter;
     trvTraceInfo: TTreeView;
+    procedure btnClipboardClick(Sender: TObject);
     procedure btnUpdateClick(Sender: TObject);
     procedure btnBrowseClick(Sender: TObject);
     procedure chkStayOnTopChange(Sender: TObject);
@@ -35,7 +37,7 @@ type
     { private declarations }
     fItems  : TList;
 
-    procedure DoUpdateLeaks;
+    procedure DoUpdateLeaks(FromClip: Boolean = False);
 
     procedure ItemsToTree;
     procedure ChangeTreeText;
@@ -93,6 +95,11 @@ begin
   DoUpdateLeaks;
 end;
 
+procedure THeapTrcViewForm.btnClipboardClick(Sender: TObject);
+begin
+  DoUpdateLeaks(True);
+end;
+
 procedure THeapTrcViewForm.btnBrowseClick(Sender: TObject);
 var
   OpenDialog : TOpenDialog;
@@ -222,18 +229,25 @@ begin
   fItems.Clear;
 end;
 
-procedure THeapTrcViewForm.DoUpdateLeaks;
+procedure THeapTrcViewForm.DoUpdateLeaks(FromClip: Boolean = False);
 var
   info  : TLeakInfo;
   data  : TLeakStatus;
+  txt: String;
 begin
   trvTraceInfo.BeginUpdate;
   try
     ClearItems;
     trvTraceInfo.Items.Clear;
-    if not FileExistsUTF8(edtTrcFileName.Text) then Exit;
+    if FromClip then begin
-
+      txt := Clipboard.AsText;
+      if txt = '' then exit;
+      info := AllocHeapTraceInfoFromText(txt);
+    end else begin
+      if (not FileExistsUTF8(edtTrcFileName.Text)) or FromClip then Exit;
       info := AllocHeapTraceInfo(edtTrcFileName.Text);
+    end;
+
     try
       if info.GetLeakInfo(data, fItems) then ItemsToTree
       else trvTraceInfo.Items.Add(nil, 'Error while parsing trace file');

components/leakview/leakinfo.pas

@@ -72,6 +72,7 @@ type
   THeapTrcInfo = class(TLeakInfo)
   protected
     fTRCFile  : string;
+    fTRCText  : string;
     Trc       : TStringList;
     TrcIndex  : integer;
     fSummary  : string;
@@ -89,10 +90,12 @@ type
   public
     TraceInfo : THeapTraceInfo;
     constructor Create(const ATRCFile: string);
+    constructor CreateFromTxt(const AText: string);
     function GetLeakInfo(var LeakData: TLeakStatus; var Traces: TList): Boolean; override;
   end;
 
 function AllocHeapTraceInfo(const TrcFile: string): TLeakInfo;
+function AllocHeapTraceInfoFromText(const TrcText: string): TLeakInfo;
 
 implementation
 
@@ -101,6 +104,11 @@ begin
   Result := THeapTrcInfo.Create(TrcFile);
 end;
 
+function AllocHeapTraceInfoFromText(const TrcText: string): TLeakInfo;
+begin
+  Result := THeapTrcInfo.CreateFromTxt(TrcText);
+end;
+
 // heap trace parsing implementation
 
 const
@@ -261,14 +269,24 @@ begin
   ClearTraceInfo(TraceInfo);
   if TrcIndex >= Trc.COunt then Exit;
   TraceInfo.ExeName := Trc[TrcIndex];
-  inc(TrcIndex);
 
-  while (TrcIndex < Trc.Count) and (not PosInTrc('Heap dump')) do
+  while (TrcIndex < Trc.Count)
+    and (not (PosInTrc('Heap dump') or  PosInTrc('Stack trace:') or PosInTrc(CallTracePrefix)) )
+  do
     inc(TrcIndex);
 
   if TrcIndex >= Trc.Count then Exit;
-  inc(TrcIndex);
 
+  if PosInTrc('Stack trace:') then begin
+    if not Assigned(traces) then Exit;
+    st := TStackTrace.Create;
+    ParseStackTrace(st); // changes TrcIndex
+    Traces.Add(st);
+    exit;
+  end;
+
+  if not PosInTrc(CallTracePrefix) then begin
+    inc(TrcIndex);
     with TraceInfo do begin
       TrcNumFirstAndAfter(AllocBlocks, AllocSize, ': '); inc(TrcIndex);
       TrcNumFirstAndAfter(FreedBlocks, FreedSize, ': '); inc(TrcIndex);
@@ -281,6 +299,7 @@ begin
         inc(TrcIndex);
       end;
     end;
+  end;
 
   if not Assigned(traces) then Exit;
 
@@ -298,15 +317,23 @@ end;
 constructor THeapTrcInfo.Create(const ATRCFile: string);
 begin
   fTrcFile := ATrcFile;
+  fTRCText := '';
   inherited Create;
 end;
 
+constructor THeapTrcInfo.CreateFromTxt(const AText: string);
+begin
+  fTRCText := AText;
+end;
+
 procedure THeapTrcInfo.ParseStackTrace(trace: TStackTrace);
 var
   i   : integer;
   err : integer;
   hex : string;
 begin
+  i := Pos('Stack trace:', Trc[TrcIndex]);
+  if i < 0 then begin
     i := Pos(CallTracePrefix, Trc[TrcIndex]);
     if i <= 0 then Exit;
 
@@ -317,6 +344,11 @@ begin
 
     Val(hex, trace.Addr, err);
     GetNumberAfter(Trc[TrcIndex], trace.BlockSize, 'size ');
+  end else begin
+    trace.RawStackData := 'Stack trace';
+    trace.Addr := 0;
+    trace.BlockSize := 0;
+  end;
 
   inc(TrcIndex);
   while (TrcIndex < Trc.Count) and (Pos(CallTracePrefix, Trc[TrcIndex]) = 0) do begin
@@ -335,11 +367,14 @@ end;
 function THeapTrcInfo.GetLeakInfo(var LeakData: TLeakStatus; var Traces: TList): Boolean;
 begin
   Result := false;
-  if not FileExistsUTF8(fTRCFile) then
+  if (not FileExistsUTF8(fTRCFile)) and (fTRCText = '') then
     Exit;
   try
     Trc := TStringList.Create;
     try
+      if fTRCText <> '' then
+        Trc.Text := fTRCText
+      else
         Trc.LoadFromFile(fTrcFile);
       TrcIndex := 0;