add a profile viewer widget, close #124

docs/index.md

@@ -62,6 +62,7 @@ _Description of each widget._
 * [Mini explorer](widgets_mini_explorer)
 * [Messages](widgets_messages)
 * [Options editor](widgets_options_editor)
+* [Profile viewer](widgets_profile_viewer)
 * [Project groups](widgets_project_groups)
 * [Project inspector](widgets_project_inspector)
 * [Process input](widgets_process_input)

docs/widgets_profile_viewer.md

@@ -0,0 +1,23 @@
+---
+title: Widgets - Profile viewer
+---
+
+{% include xstyle.css %}
+
+### Profile viewer
+
+#### Description
+
+The _profile viewer_ widget displays the results stored in the _trace.log_ file that a software compiled with DMD outputs when it's compiled with the `-profile` switch.
+
+![](img/profile_viewer.png)
+
+The pie displays the weight of a each function for a particular criterion.
+This criterion can be selected in the combo box that's located in the toolbar.
+
+The list displays all the results, which can be inspected more accurately after sorting a column.
+
+#### Toolbar
+
+- <img src="{%include icurl%}folder/folder.png" class="tlbric"/>: Propose to open the _trace.log_ from a dialog.
+- <img src="{%include icurl%}arrow/arrow_update.png" class="tlbric"/>: Reloads the current _trace.log_ or tries to load it from the current directory.

lazproj/coedit.lpi

@@ -221,28 +221,31 @@
         <FormatVersion Value="1"/>
       </local>
     </RunParams>
-    <RequiredPackages Count="7">
+    <RequiredPackages Count="8">
       <Item1>
-        <PackageName Value="cedsgncontrols"/>
+        <PackageName Value="TAChartLazarusPkg"/>
       </Item1>
       <Item2>
-        <PackageName Value="anchordocking"/>
+        <PackageName Value="cedsgncontrols"/>
       </Item2>
       <Item3>
-        <PackageName Value="FCL"/>
+        <PackageName Value="anchordocking"/>
       </Item3>
       <Item4>
-        <PackageName Value="RunTimeTypeInfoControls"/>
+        <PackageName Value="FCL"/>
       </Item4>
       <Item5>
-        <PackageName Value="SynEdit"/>
+        <PackageName Value="RunTimeTypeInfoControls"/>
       </Item5>
       <Item6>
-        <PackageName Value="LazControls"/>
+        <PackageName Value="SynEdit"/>
       </Item6>
       <Item7>
-        <PackageName Value="LCL"/>
+        <PackageName Value="LazControls"/>
       </Item7>
+      <Item8>
+        <PackageName Value="LCL"/>
+      </Item8>
     </RequiredPackages>
     <Units Count="58">
       <Unit0>
@@ -536,12 +539,14 @@
       <Unit56>
         <Filename Value="..\src\ce_diff.pas"/>
         <IsPartOfProject Value="True"/>
+        <ComponentName Value="CEDiffViewer"/>
         <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
       </Unit56>
       <Unit57>
-        <Filename Value="..\src\ce_diff.pas"/>
+        <Filename Value="..\src\ce_profileviewer.pas"/>
         <IsPartOfProject Value="True"/>
-        <ComponentName Value="CEDiffViewer"/>
+        <ComponentName Value="CEProfileViewerWidget"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
       </Unit57>

lazproj/coedit.lpr

@@ -7,12 +7,13 @@ uses
   cthreads,
   {$ENDIF}{$ENDIF}
   Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, anchordockpkg,
-  ce_sharedres, ce_observer, ce_libman, ce_symstring, ce_tools, ce_dcd, ce_main,
-  ce_writableComponent, ce_staticmacro, ce_inspectors, ce_editoroptions,
-  ce_dockoptions, ce_shortcutseditor, ce_mru, ce_processes,
-  ce_dialogs, ce_dubprojeditor, ce_controls, ce_dfmt, ce_lcldragdrop,
-  ce_stringrange, ce_dlangmaps, ce_projgroup, ce_projutils, ce_d2synpresets,
-  ce_dastworx, ce_dbgitf, ce_ddemangle, ce_dubproject, ce_halstead, ce_diff;
+  tachartlazaruspkg, ce_sharedres, ce_observer, ce_libman, ce_symstring,
+  ce_tools, ce_dcd, ce_main, ce_writableComponent, ce_staticmacro,
+  ce_inspectors, ce_editoroptions, ce_dockoptions, ce_shortcutseditor, ce_mru,
+  ce_processes, ce_dialogs, ce_dubprojeditor, ce_controls, ce_dfmt,
+  ce_lcldragdrop, ce_stringrange, ce_dlangmaps, ce_projgroup, ce_projutils,
+  ce_d2synpresets, ce_dastworx, ce_dbgitf, ce_ddemangle, ce_dubproject,
+  ce_halstead, ce_diff, ce_profileviewer;
 
 {$R *.res}
 

src/ce_main.pas

@@ -16,7 +16,7 @@ uses
   ce_toolseditor, ce_procinput, ce_optionseditor, ce_symlist, ce_mru, ce_processes,
   ce_infos, ce_dubproject, ce_dialogs, ce_dubprojeditor,{$IFDEF UNIX} ce_gdb,{$ENDIF}
   ce_dfmt, ce_lcldragdrop, ce_projgroup, ce_projutils, ce_stringrange, ce_dastworx,
-  ce_halstead;
+  ce_halstead, ce_profileviewer;
 
 type
 
@@ -377,7 +377,8 @@ type
     {$IFDEF UNIX}
     fGdbWidg: TCEGdbWidget;
     {$ENDIF}
-    fDfmtWidg:  TCEDfmtWidget;
+    fDfmtWidg: TCEDfmtWidget;
+    fProfWidg: TCEProfileViewerWidget;
     fCompStart: TDateTime;
 
     fRunProjAfterCompArg: boolean;
@@ -1297,6 +1298,7 @@ begin
   fDubProjWidg:= TCEDubProjectEditorWidget.create(self);
   fDfmtWidg   := TCEDfmtWidget.create(self);
   fPrjGrpWidg := TCEProjectGroupWidget.create(self);
+  fProfWidg   := TCEProfileViewerWidget.create(self);
   {$IFDEF UNIX}
   fGdbWidg    := TCEGdbWidget.create(self);
   {$ENDIF}
@@ -1319,6 +1321,7 @@ begin
   fWidgList.addWidget(@fDubProjWidg);
   fWidgList.addWidget(@fDfmtWidg);
   fWidgList.addWidget(@fPrjGrpWidg);
+  fWidgList.addWidget(@fProfWidg);
   {$IFDEF UNIX}
   fWidgList.addWidget(@fGdbWidg);
   {$ENDIF}

src/ce_profileviewer.lfm

@@ -0,0 +1,205 @@
+inherited CEProfileViewerWidget: TCEProfileViewerWidget
+  Left = 979
+  Height = 537
+  Top = 198
+  Width = 551
+  Caption = 'Profile viewer'
+  ClientHeight = 537
+  ClientWidth = 551
+  inherited Back: TPanel
+    Height = 537
+    Width = 551
+    ClientHeight = 537
+    ClientWidth = 551
+    inherited Content: TPanel
+      Height = 501
+      Width = 551
+      ClientHeight = 501
+      ClientWidth = 551
+      object list: TListView[0]
+        Left = 4
+        Height = 283
+        Top = 214
+        Width = 543
+        Align = alClient
+        BorderSpacing.Around = 4
+        Columns = <        
+          item
+            AutoSize = True
+            Caption = 'Num calls'
+            Width = 71
+          end        
+          item
+            AutoSize = True
+            Caption = 'Tree time'
+            Width = 67
+          end        
+          item
+            AutoSize = True
+            Caption = 'Func time'
+            Width = 72
+          end        
+          item
+            AutoSize = True
+            Caption = 'Per call'
+            Width = 55
+          end        
+          item
+            AutoSize = True
+            Caption = 'function'
+            Width = 274
+          end>
+        ReadOnly = True
+        ScrollBars = ssAutoBoth
+        SortType = stText
+        TabOrder = 0
+        ViewStyle = vsReport
+      end
+      object Panel1: TPanel[1]
+        Left = 2
+        Height = 200
+        Top = 2
+        Width = 547
+        Align = alTop
+        BorderSpacing.Around = 2
+        BevelOuter = bvNone
+        ClientHeight = 200
+        ClientWidth = 547
+        TabOrder = 1
+        object pie: TChart
+          Left = 2
+          Height = 196
+          Top = 2
+          Width = 543
+          AxisList = <          
+            item
+              Marks.Clipped = False
+              Minors = <>
+            end          
+            item
+              Alignment = calBottom
+              Marks.Clipped = False
+              Minors = <>
+            end>
+          AxisVisible = False
+          Foot.Brush.Color = clBtnFace
+          Foot.Font.Color = clBlue
+          Frame.Style = psClear
+          Title.Brush.Color = clBtnFace
+          Title.Font.Color = clBlue
+          Title.Text.Strings = (
+            'TAChart'
+          )
+          Toolset = pieTools
+          Align = alClient
+          BorderSpacing.Around = 2
+          object pieSeries: TPieSeries
+            Legend.Visible = False
+            Marks.Clipped = False
+            Marks.Distance = 10
+            Marks.Shape = clsRoundRect
+            Marks.Format = '%2:s %1:.2f%%'
+            Marks.Style = smsLabelPercent
+            FixedRadius = 100
+            MarkPositions = pmpLeftRight
+          end
+        end
+      end
+      object Splitter1: TSplitter[2]
+        Cursor = crVSplit
+        Left = 0
+        Height = 6
+        Top = 204
+        Width = 551
+        Align = alTop
+        OnMoved = Splitter1Moved
+        ResizeAnchor = akTop
+      end
+    end
+    inherited toolbar: TCEToolBar
+      Width = 543
+      object btnRefresh: TCEToolButton[0]
+        Left = 29
+        Hint = 'reload current trace log file or auto load from the current directory'
+        Top = 0
+        Caption = 'btnRefresh'
+        OnClick = btnRefreshClick
+        resourceName = 'ARROW_UPDATE'
+        scaledSeparator = False
+      end
+      object btnOpen: TCEToolButton[1]
+        Left = 1
+        Hint = 'open a trace log file'
+        Top = 0
+        Caption = 'btnOpen'
+        OnClick = btnOpenClick
+        resourceName = 'FOLDER'
+        scaledSeparator = False
+      end
+      object button0: TCEToolButton[2]
+        Left = 57
+        Height = 28
+        Top = 0
+        Width = 13
+        Caption = 'button0'
+        Style = tbsDivider
+        scaledSeparator = False
+      end
+      object selPieSource: TComboBox[3]
+        Left = 70
+        Height = 28
+        Hint = 'select the pie representation'
+        Top = 0
+        Width = 154
+        BorderSpacing.InnerBorder = 3
+        ItemHeight = 0
+        ItemIndex = 0
+        Items.Strings = (
+          'Number of calls'
+          'Tree time'
+          'Function time'
+          'Time per call'
+        )
+        OnSelect = selPieSourceSelect
+        Style = csDropDownList
+        TabOrder = 0
+        Text = 'Number of calls'
+      end
+    end
+  end
+  inherited contextMenu: TPopupMenu
+    left = 16
+    top = 152
+  end
+  object pieTools: TChartToolset[2]
+    left = 192
+    top = 112
+    object pieToolsZoomMouseWheelTool1: TZoomMouseWheelTool
+      ZoomFactor = 2
+      ZoomRatio = 2
+    end
+    object pieToolsPanDragTool1: TPanDragTool
+      Shift = [ssRight]
+    end
+  end
+  object datNumCalls: TListChartSource[3]
+    Sorted = True
+    left = 192
+    top = 56
+  end
+  object datTreeTime: TListChartSource[4]
+    Sorted = True
+    left = 232
+    top = 56
+  end
+  object datFuncTime: TListChartSource[5]
+    Sorted = True
+    left = 272
+    top = 56
+  end
+  object datPerCall: TListChartSource[6]
+    Sorted = True
+    left = 312
+    top = 56
+  end
+end

src/ce_profileviewer.pas

@@ -0,0 +1,278 @@
+unit ce_profileviewer;
+
+{$I ce_defines.inc}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, TASources, TAGraph, TATransformations, TASeries,
+  TATools, Forms, Controls, Graphics, Dialogs, ExtCtrls, Menus, ComCtrls,
+  StdCtrls, ce_widget, ce_common, ce_stringrange, ce_dsgncontrols, ce_ddemangle;
+
+type
+
+  TCEProfileViewerWidget = class(TCEWidget)
+    btnOpen: TCEToolButton;
+    btnRefresh: TCEToolButton;
+    button0: TCEToolButton;
+    selPieSource: TComboBox;
+    pieTools: TChartToolset;
+    pieToolsPanDragTool1: TPanDragTool;
+    pieToolsZoomMouseWheelTool1: TZoomMouseWheelTool;
+    datNumCalls: TListChartSource;
+    datTreeTime: TListChartSource;
+    datFuncTime: TListChartSource;
+    datPerCall: TListChartSource;
+    Panel1: TPanel;
+    pie: TChart;
+    list: TListView;
+    pieSeries: TPieSeries;
+    Splitter1: TSplitter;
+    procedure btnOpenClick(Sender: TObject);
+    procedure btnRefreshClick(Sender: TObject);
+    procedure selPieSourceSelect(Sender: TObject);
+    procedure selPieSourceSelectionChange(Sender: TObject; User: boolean);
+    procedure Splitter1Moved(Sender: TObject);
+  private
+    logFname: string;
+    procedure clearViewer;
+    procedure updateFromFile(const fname: string);
+    procedure updatePie;
+    procedure listCompare(Sender: TObject; item1, item2: TListItem; Data: Integer; var Compare: Integer);
+  public
+    constructor create(aOwner: TComponent); override;
+  end;
+
+implementation
+{$R *.lfm}
+
+constructor TCEProfileViewerWidget.create(aOwner: TComponent);
+begin
+  inherited;
+  clearViewer;
+  updatePie;
+  list.OnCompare:=@listCompare;
+end;
+
+procedure TCEProfileViewerWidget.btnRefreshClick(Sender: TObject);
+var
+  fname: string;
+begin
+  if logFname.isNotEmpty and logFname.fileExists then
+    updateFromFile(logFname)
+  else
+  begin
+    fname := GetCurrentDir + DirectorySeparator + 'trace.log';
+    if fileExists(fname) then
+    begin
+      updateFromFile(fname);
+      logFname:=fname;
+    end;
+  end;
+end;
+
+procedure TCEProfileViewerWidget.selPieSourceSelect(Sender: TObject);
+begin
+  updatePie;
+end;
+
+procedure TCEProfileViewerWidget.btnOpenClick(Sender: TObject);
+begin
+  with TOpenDialog.Create(nil) do
+  try
+    if logFname.fileExists and logFname.isNotEmpty then
+      FileName := logFname;
+    if execute then
+    begin
+      updateFromFile(filename);
+      logFname := FileName;
+    end;
+  finally
+    free;
+  end;
+end;
+
+procedure TCEProfileViewerWidget.updatePie;
+begin
+  case selPieSource.ItemIndex of
+    1: pieSeries.ListSource.DataPoints.Assign(datTreeTime.DataPoints);
+    2: pieSeries.ListSource.DataPoints.Assign(datFuncTime.DataPoints);
+    3: pieSeries.ListSource.DataPoints.Assign(datPerCall.DataPoints);
+    else pieSeries.ListSource.DataPoints.Assign(datNumCalls.DataPoints);
+  end;
+  pieSeries.FixedRadius:= pie.Height div 2 - 10;
+end;
+
+procedure TCEProfileViewerWidget.selPieSourceSelectionChange(Sender: TObject;User: boolean);
+begin
+  updatePie;
+end;
+
+procedure TCEProfileViewerWidget.Splitter1Moved(Sender: TObject);
+begin
+  updatePie;
+end;
+
+procedure TCEProfileViewerWidget.clearViewer;
+begin
+  list.Clear;
+  pieSeries.Clear;
+  datFuncTime.Clear;
+  datNumCalls.Clear;
+  datTreeTime.Clear;
+  datPerCall.Clear;
+end;
+
+procedure TCEProfileViewerWidget.updateFromFile(const fname: string);
+var
+  log: string;
+  rng: TStringRange = (ptr:nil; pos:0; len: 0);
+  tps: qword;
+  idt: string;
+  fnc: qword;
+  fft: qword;
+  ftt: qword;
+  fpc: qword;
+
+  procedure fillRow();
+  var
+    itm: TListItem;
+  begin
+    list.AddItem(fnc.ToString, nil);
+    itm := list.Items[list.Items.Count-1];
+    itm.SubItems.Add(fft.ToString);
+    itm.SubItems.Add(ftt.ToString);
+    itm.SubItems.Add(fpc.ToString);
+    itm.SubItems.Add(idt);
+    datNumCalls.Add(100, fnc, idt);
+    datFuncTime.Add(100, fft, idt);
+    datTreeTime.Add(100, ftt, idt);
+    datPerCall.Add(100, fpc, idt);
+  end;
+
+begin
+  clearViewer;
+
+  if not fname.fileExists or (fname.extractFileName <> 'trace.log') then
+    exit;
+
+  with TStringList.Create do
+  try
+    loadFromFile(fname);
+    log := strictText;
+  finally
+    free;
+  end;
+
+  if log.length = 0 then
+    exit;
+
+  // ======== Timer Is 35.... ============
+  rng.init(log);
+  rng.popUntil('=')^.popUntil(['0','1','2','3','4','5','6','7','8','9']);
+  if rng.empty then
+    exit;
+  idt := rng.nextWord;
+  tps := StrToQWordDef(idt, 0);
+
+  // columns headers
+  if rng.popLine^.empty then
+    exit;
+  if rng.popLine^.empty then
+    exit;
+  if rng.popLine^.empty then
+    exit;
+  if rng.popLine^.empty then
+    exit;
+  if rng.popLine^.empty then
+    exit;
+
+  list.BeginUpdate;
+
+  // each function
+  while true do
+  begin
+
+    idt:= 'unknown function';
+    fnc:= 0;
+    fft:= 0;
+    ftt:= 0;
+    fpc:= 0;
+    // num calls
+    fnc := StrToQWordDef(rng.nextWord, 0);
+    if not rng.empty then
+      rng.popFront
+    else
+      break;
+    // function time
+    fft := StrToQWordDef(rng.nextWord, 0);
+    if not rng.empty then
+      rng.popFront
+    else
+      break;
+    // tree time
+    ftt := StrToQWordDef(rng.nextWord, 0);
+    if not rng.empty then
+      rng.popFront
+    else
+      break;
+    // per call
+    fpc := StrToQWordDef(rng.nextWord, 0);
+    if not rng.empty then
+      rng.popFront
+    else
+      break;
+    // function name
+    rng.popWhile(' ')^.empty;
+    idt := demangle(rng.takeUntil(#10).yield);
+
+    fillRow;
+
+    if not rng.empty then
+      rng.popFront
+    else
+      break;
+  end;
+
+  list.EndUpdate;
+  updatePie;
+
+end;
+
+procedure TCEProfileViewerWidget.listCompare(Sender: TObject; item1, item2: TListItem; Data: Integer; var Compare: Integer);
+var
+  txt1: string = '';
+  txt2: string = '';
+  i1, i2: qword;
+  col: Integer;
+begin
+  col := list.SortColumn;
+  if col = 4 then
+  begin
+    Compare := AnsiCompareStr(txt1, txt2);
+  end
+  else
+  begin
+    if col = 0 then
+    begin
+      i1 := item1.Caption.ToInt64;
+      i2 := item2.Caption.ToInt64;
+    end
+    else
+    begin
+      i1 := item1.SubItems[col-1].ToInt64;
+      i2 := item2.SubItems[col-1].ToInt64;
+    end;
+    if (i1 = i2)
+      then Compare := 0
+    else if (i1 < i2)
+      then Compare := -1
+    else
+      Compare := 1;
+  end;
+  if list.SortDirection = sdDescending then
+    Compare := -Compare;
+end;
+
+end.
+

src/ce_stringrange.pas

@@ -75,6 +75,9 @@ type
     // advances the range until the front is equal to value.
     function popUntil(value: Char): PStringRange; overload; {$IFNDEF DEBUG}inline;{$ENDIF}
 
+    // advances the range until the beginning of the next line.
+    function popLine: PStringRange; {$IFNDEF DEBUG}inline;{$ENDIF}
+
     // returns the next word.
     function nextWord: string; {$IFNDEF DEBUG}inline;{$ENDIF}
     // returns the next line.
@@ -267,6 +270,14 @@ begin
   Result := @self;
 end;
 
+function TStringRange.popLine: PStringRange;
+begin
+  popUntil(#10);
+  if not empty then
+    popFront;
+  Result := @self;
+end;
+
 function TStringRange.nextWord: string;
 const
   blk = [#0 .. #32];