codetools: started ppu list dialog

git-svn-id: trunk@29430 -
2025-06-01 20:12:36 +02:00 · 2011-02-09 18:03:12 +00:00 · 2011-02-09 18:03:12 +00:00 · c1b1dd273a
commit c1b1dd273a
parent a63a10dee6
7 changed files with 507 additions and 0 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -529,6 +529,12 @@ components/codetools/findoverloads.pas svneol=native#text/plain
 components/codetools/fpcsrcrules.inc svneol=native#text/plain
 components/codetools/fpmake.pas svneol=native#text/plain
 components/codetools/h2pastool.pas svneol=native#text/plain
+components/codetools/ide/cody.lpk svneol=native#text/plain
+components/codetools/ide/cody.pas svneol=native#text/pascal
+components/codetools/ide/codystrconsts.pas svneol=native#text/pascal
+components/codetools/ide/ppulistdlg.lfm svneol=native#text/plain
+components/codetools/ide/ppulistdlg.lrs svneol=native#text/plain
+components/codetools/ide/ppulistdlg.pas svneol=native#text/pascal
 components/codetools/identcompletiontool.pas svneol=native#text/pascal
 components/codetools/keywordfunclists.pas svneol=native#text/pascal
 components/codetools/languages/README.txt svneol=native#text/plain
--- a/components/codetools/ide/cody.lpk
+++ b/components/codetools/ide/cody.lpk
@ -0,0 +1,57 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <Package Version="3">
+    <Name Value="Cody"/>
+    <Author Value="Mattias Gaertner - mattias@freepascal.org"/>
+    <CompilerOptions>
+      <Version Value="10"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/"/>
+      </SearchPaths>
+      <Other>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Description Value="IDE extensions using Codetools."/>
+    <License Value="GPL2"/>
+    <Version Major="1" Release="1"/>
+    <Files Count="2">
+      <Item1>
+        <Filename Value="ppulistdlg.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="PPUListDlg"/>
+      </Item1>
+      <Item2>
+        <Filename Value="codystrconsts.pas"/>
+        <UnitName Value="CodyStrConsts"/>
+      </Item2>
+    </Files>
+    <LazDoc Paths="doc"/>
+    <i18n>
+      <EnableI18N Value="True"/>
+      <OutDir Value="languages"/>
+    </i18n>
+    <Type Value="RunAndDesignTime"/>
+    <RequiredPkgs Count="4">
+      <Item1>
+        <PackageName Value="LCLBase"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="IDEIntf"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="CodeTools"/>
+      </Item3>
+      <Item4>
+        <PackageName Value="FCL"/>
+        <MinVersion Major="1" Release="1" Valid="True"/>
+      </Item4>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>
--- a/components/codetools/ide/cody.pas
+++ b/components/codetools/ide/cody.pas
@ -0,0 +1,21 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit Cody; 
+
+interface
+
+uses
+  PPUListDlg, CodyStrConsts, LazarusPackageIntf;
+
+implementation
+
+procedure Register; 
+begin
+  RegisterUnit('PPUListDlg', @PPUListDlg.Register); 
+end; 
+
+initialization
+  RegisterPackage('Cody', @Register); 
+end.
--- a/components/codetools/ide/codystrconsts.pas
+++ b/components/codetools/ide/codystrconsts.pas
@ -0,0 +1,39 @@
+{
+ ***************************************************************************
+ *                                                                         *
+ *   This source is free software; you can redistribute it and/or modify   *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ *   This code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+
+  Author: Mattias Gaertner
+
+  Abstract:
+    The resource strings of the package.
+}
+unit CodyStrConsts;
+
+{$mode objfpc}{$H+}
+
+interface
+
+resourcestring
+  crsNoProject = 'No project';
+  crsPleaseOpenAProjectFirst = 'Please open a project first.';
+
+implementation
+
+end.
+
--- a/components/codetools/ide/ppulistdlg.lfm
+++ b/components/codetools/ide/ppulistdlg.lfm
@ -0,0 +1,69 @@
+object PPUListDialog: TPPUListDialog
+  Left = 275
+  Height = 406
+  Top = 250
+  Width = 533
+  Caption = 'PPUListDialog'
+  ClientHeight = 406
+  ClientWidth = 533
+  OnClose = FormClose
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  Position = poScreenCenter
+  LCLVersion = '0.9.31'
+  object ButtonPanel1: TButtonPanel
+    Left = 6
+    Height = 40
+    Top = 360
+    Width = 521
+    OKButton.Name = 'OKButton'
+    OKButton.Caption = '&OK'
+    OKButton.Enabled = False
+    HelpButton.Name = 'HelpButton'
+    HelpButton.Caption = '&Help'
+    HelpButton.Enabled = False
+    CloseButton.Name = 'CloseButton'
+    CloseButton.Caption = '&Close'
+    CancelButton.Name = 'CancelButton'
+    CancelButton.Caption = 'Cancel'
+    CancelButton.Enabled = False
+    TabOrder = 0
+    ShowButtons = [pbClose]
+  end
+  object UnitsStringGrid: TStringGrid
+    Left = 6
+    Height = 324
+    Top = 30
+    Width = 521
+    Align = alClient
+    AutoFillColumns = True
+    BorderSpacing.Around = 6
+    ColCount = 3
+    Columns = <    
+      item
+        Title.Caption = 'Size of .ppu file'
+        Width = 227
+      end    
+      item
+        Title.Caption = 'Size of .o file'
+        Width = 228
+      end>
+    FixedRows = 2
+    TabOrder = 1
+    ColWidths = (
+      64
+      227
+      228
+    )
+  end
+  object ScopeLabel: TLabel
+    Left = 6
+    Height = 18
+    Top = 6
+    Width = 521
+    Align = alTop
+    BorderSpacing.Around = 6
+    Caption = 'ScopeLabel'
+    ParentColor = False
+  end
+end
--- a/components/codetools/ide/ppulistdlg.lrs
+++ b/components/codetools/ide/ppulistdlg.lrs
@ -0,0 +1,23 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TPPUListDialog','FORMDATA',[
+  'TPF0'#14'TPPUListDialog'#13'PPUListDialog'#4'Left'#3#19#1#6'Height'#3#150#1#3
+  +'Top'#3#250#0#5'Width'#3#21#2#7'Caption'#6#13'PPUListDialog'#12'ClientHeight'
+  +#3#150#1#11'ClientWidth'#3#21#2#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'F'
+  +'ormCreate'#9'OnDestroy'#7#11'FormDestroy'#8'Position'#7#14'poScreenCenter'
+  +#10'LCLVersion'#6#6'0.9.31'#0#12'TButtonPanel'#12'ButtonPanel1'#4'Left'#2#6#6
+  +'Height'#2'('#3'Top'#3'h'#1#5'Width'#3#9#2#13'OKButton.Name'#6#8'OKButton'#16
+  +'OKButton.Caption'#6#3'&OK'#16'OKButton.Enabled'#8#15'HelpButton.Name'#6#10
+  +'HelpButton'#18'HelpButton.Caption'#6#5'&Help'#18'HelpButton.Enabled'#8#16'C'
+  +'loseButton.Name'#6#11'CloseButton'#19'CloseButton.Caption'#6#6'&Close'#17'C'
+  +'ancelButton.Name'#6#12'CancelButton'#20'CancelButton.Caption'#6#6'Cancel'#20
+  +'CancelButton.Enabled'#8#8'TabOrder'#2#0#11'ShowButtons'#11#7'pbClose'#0#0#0
+  +#11'TStringGrid'#15'UnitsStringGrid'#4'Left'#2#6#6'Height'#3'D'#1#3'Top'#2#30
+  +#5'Width'#3#9#2#5'Align'#7#8'alClient'#15'AutoFillColumns'#9#20'BorderSpacin'
+  +'g.Around'#2#6#8'ColCount'#2#3#7'Columns'#14#1#13'Title.Caption'#6#17'Size o'
+  +'f .ppu file'#5'Width'#3#227#0#0#1#13'Title.Caption'#6#15'Size of .o file'#5
+  +'Width'#3#228#0#0#0#9'FixedRows'#2#2#8'TabOrder'#2#1#9'ColWidths'#1#2'@'#3
+  +#227#0#3#228#0#0#0#0#6'TLabel'#10'ScopeLabel'#4'Left'#2#6#6'Height'#2#18#3'T'
+  +'op'#2#6#5'Width'#3#9#2#5'Align'#7#5'alTop'#20'BorderSpacing.Around'#2#6#7'C'
+  +'aption'#6#10'ScopeLabel'#11'ParentColor'#8#0#0#0
+]);
--- a/components/codetools/ide/ppulistdlg.pas
+++ b/components/codetools/ide/ppulistdlg.pas
@ -0,0 +1,292 @@
+{
+ ***************************************************************************
+ *                                                                         *
+ *   This source is free software; you can redistribute it and/or modify   *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ *   This code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+
+  Author: Mattias Gaertner
+
+  Abstract:
+    An IDE dialog showing all used ppus of a project.
+}
+unit PPUListDlg;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
+  ButtonPanel, Grids, StdCtrls, AvgLvlTree,
+  // IDEIntf
+  IDECommands, MenuIntf, ProjectIntf, LazIDEIntf, IDEDialogs, IDEWindowIntf,
+  // codetools
+  BasicCodeTools, FileProcs, CodyStrConsts;
+
+const
+  PPUFileNotFound = ' ';
+type
+  TPPUListType = (
+    pltUsedBy,
+    pltUses
+    );
+
+  { TPPUListItem }
+
+  TPPUListItem = class
+  public
+    TheUnitName: string;
+    SrcFile: string;
+    PPUFile: string; // = '' means not searched, = PPUFileNotFound means not found
+    OFile: string;
+    PPUFileSize: int64;
+    OFileSize: int64;
+    First, Last, Next, Prev: array[TPPUListType] of TPPUListItem;
+    procedure AppendToList(var aFirst, aLast: TPPUListItem; ListType: TPPUListType);
+    procedure RemoveFromList(var aFirst, aLast: TPPUListItem; ListType: TPPUListType);
+  end;
+
+  { TPPUListDialog }
+
+  TPPUListDialog = class(TForm)
+    ButtonPanel1: TButtonPanel;
+    ScopeLabel: TLabel;
+    UnitsStringGrid: TStringGrid;
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+  private
+    FAProject: TLazProject;
+    FIdleConnected: boolean;
+    FSearchingItems: TAvgLvlTree; // tree of TPPUListItem sorted for TheUnitName
+    FItems: TAvgLvlTree; // tree of TPPUListItem sorted for TheUnitName
+    procedure SetAProject(const AValue: TLazProject);
+    procedure SetIdleConnected(const AValue: boolean);
+    procedure OnIdle(Sender: TObject; var Done: Boolean);
+    procedure UpdateAll;
+    procedure UpdateUnitsGrid;
+  public
+    property AProject: TLazProject read FAProject write SetAProject;
+    property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
+  end;
+
+procedure ShowPPUList(Sender: TObject);
+function ComparePPUListItems(Item1, Item2: Pointer): integer;
+function CompareUnitNameWithPPUListItem(TheUnitName, Item: Pointer): integer;
+
+procedure Register;
+
+implementation
+
+procedure ShowPPUList(Sender: TObject);
+var
+  Dlg: TPPUListDialog;
+begin
+  if LazarusIDE.ActiveProject=nil then begin
+    IDEMessageDialog(crsNoProject, crsPleaseOpenAProjectFirst, mtError, [mbCancel]);
+    exit;
+  end;
+  Dlg:=TPPUListDialog.Create(nil);
+  try
+    Dlg.AProject:=LazarusIDE.ActiveProject;
+    Dlg.ShowModal;
+  finally
+    Dlg.Free;
+  end;
+end;
+
+function ComparePPUListItems(Item1, Item2: Pointer): integer;
+var
+  li1: TPPUListItem absolute Item1;
+  li2: TPPUListItem absolute Item2;
+begin
+  Result:=CompareIdentifiers(PChar(li1.TheUnitName),PChar(li2.TheUnitName));
+end;
+
+function CompareUnitNameWithPPUListItem(TheUnitName, Item: Pointer): integer;
+var
+  li: TPPUListItem absolute Item;
+  un: PChar;
+begin
+  un:=PChar(AnsiString(TheUnitName));
+  Result:=CompareIdentifiers(un,PChar(li.TheUnitName));
+end;
+
+procedure Register;
+var
+  CmdCategory: TIDECommandCategory;
+  PPUListCommand: TIDECommand;
+begin
+  CmdCategory:=IDECommandList.FindCategoryByName('ProjectMenu');
+  if CmdCategory=nil then
+    raise Exception.Create('cody: PPUListDlg.Register: command category ProjectMenu not found');
+  PPUListCommand:=RegisterIDECommand(CmdCategory,'ShowPPUList','Show used .ppu files',
+    CleanIDEShortCut,CleanIDEShortCut,nil,@ShowPPUList);
+  RegisterIDEMenuCommand(itmProjectWindowSection,'PPUList','Show used .ppu files',
+    nil,nil,PPUListCommand);
+end;
+
+{ TPPUListItem }
+
+procedure TPPUListItem.AppendToList(var aFirst, aLast: TPPUListItem;
+  ListType: TPPUListType);
+begin
+  if (Next[ListType]<>nil) or (Prev[ListType]<>nil) then
+    RaiseCatchableException('TPPUListItem.AppendToList');
+  if aFirst=nil then
+    aFirst:=Self;
+  Prev[ListType]:=aLast;
+  if Prev[ListType]<>nil then Prev[ListType].Next[ListType]:=Self;
+  aLast:=Self;
+end;
+
+procedure TPPUListItem.RemoveFromList(var aFirst, aLast: TPPUListItem;
+  ListType: TPPUListType);
+begin
+  if aFirst=Self then aFirst:=Next[ListType];
+  if aLast=Self then aLast:=Prev[ListType];
+  if Prev[ListType]<>nil then Prev[ListType].Next[ListType]:=Next[ListType];
+  if Next[ListType]<>nil then Next[ListType].Prev[ListType]:=Prev[ListType];
+  Prev[ListType]:=nil;
+  Next[ListType]:=nil;
+end;
+
+{ TPPUListDialog }
+
+procedure TPPUListDialog.FormCreate(Sender: TObject);
+begin
+  FSearchingItems:=TAvgLvlTree.Create(@ComparePPUListItems);
+  FItems:=TAvgLvlTree.Create(@ComparePPUListItems);
+
+  Caption:='Used ppu files of project';
+  IDEDialogLayoutList.ApplyLayout(Self);
+end;
+
+procedure TPPUListDialog.FormDestroy(Sender: TObject);
+begin
+  FreeAndNil(FSearchingItems);
+  FItems.FreeAndClear;
+  FreeAndNil(FItems);
+end;
+
+procedure TPPUListDialog.FormClose(Sender: TObject;
+  var CloseAction: TCloseAction);
+begin
+  IDEDialogLayoutList.SaveLayout(Self);
+end;
+
+procedure TPPUListDialog.SetAProject(const AValue: TLazProject);
+begin
+  if FAProject=AValue then exit;
+  FAProject:=AValue;
+  UpdateAll;
+end;
+
+procedure TPPUListDialog.SetIdleConnected(const AValue: boolean);
+begin
+  if FIdleConnected=AValue then exit;
+  FIdleConnected:=AValue;
+  if IdleConnected then
+    Application.AddOnIdleHandler(@OnIdle)
+  else
+    Application.RemoveOnIdleHandler(@OnIdle);
+end;
+
+procedure TPPUListDialog.UpdateAll;
+var
+  s: String;
+  MainUnit: TLazProjectFile;
+begin
+  if AProject=nil then exit;
+
+  FSearchingItems.Clear;
+  FItems.FreeAndClear;
+
+  // caption
+  s:='';
+  if AProject.Title<>'' then
+    s:=AProject.Title
+  else
+    s:=ExtractFileNameOnly(AProject.ProjectInfoFile);
+  Caption:='PPU files of project "'+dbgstr(s)+'"';
+
+  // ScopeLabel
+  MainUnit:=AProject.MainFile;
+  if MainUnit=nil then begin
+    ScopeLabel.Caption:='Project has no main source file.';
+  end else begin
+    ScopeLabel.Caption:='Main source file: '+MainUnit.Filename;
+  end;
+
+  IdleConnected:=true;
+end;
+
+procedure TPPUListDialog.UpdateUnitsGrid;
+var
+  Grid: TStringGrid;
+  SortedItems: TFPList;
+  Node: TAvgLvlTreeNode;
+  Item: TPPUListItem;
+  i: Integer;
+begin
+  Grid:=UnitsStringGrid;
+  Grid.BeginUpdate;
+  Grid.RowCount:=2+FItems.Count;
+
+  // header
+  Grid.Cells[0,0]:='Unit';
+  Grid.Cells[1,0]:='Size of .ppu file';
+  Grid.Cells[2,0]:='Size of .o file';
+
+  // total
+  Grid.Cells[0,0]:='Unit';
+  Grid.Cells[1,0]:='0 bytes / 100%';
+  Grid.Cells[2,0]:='0 bytes / 100%';
+
+  SortedItems:=TFPList.Create;
+  try
+    Node:=FItems.FindLowest;
+    while Node<>nil do begin
+      SortedItems.Add(TPPUListItem(Node.Data));
+      Node:=FItems.FindSuccessor(Node);
+    end;
+
+    // ToDo: sort
+
+    for i:=0 to SortedItems.Count-1 do begin
+      Item:=TPPUListItem(SortedItems[i]);
+
+    end;
+
+  finally
+    SortedItems.Free;
+  end;
+
+  Grid.EndUpdate;
+end;
+
+procedure TPPUListDialog.OnIdle(Sender: TObject; var Done: Boolean);
+begin
+  UpdateUnitsGrid;
+  IdleConnected:=false;
+end;
+
+initialization
+  {$I ppulistdlg.lrs}
+
+end.
+