added ce_todolist, the todo list widget

lazproj/coedit.lpi

@@ -140,7 +140,7 @@
         <PackageName Value="LCL"/>
       </Item6>
     </RequiredPackages>
-    <Units Count="33">
+    <Units Count="34">
       <Unit0>
         <Filename Value="coedit.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -345,6 +345,14 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="ce_icons"/>
       </Unit32>
+      <Unit33>
+        <Filename Value="..\src\ce_todolist.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="CETodoListWidget"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="ce_todolist"/>
+      </Unit33>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

src/ce_main.pas

@@ -10,7 +10,7 @@ uses
   Dialogs, Menus, ActnList, ExtCtrls, process, XMLPropStorage, dynlibs, SynExportHTML,
   ce_common, ce_dmdwrap, ce_project, ce_dcd, ce_plugin, ce_synmemo, ce_widget,
   ce_messages, ce_interfaces, ce_editor, ce_projinspect, ce_projconf, ce_search,
-  ce_staticexplorer, ce_miniexplorer, ce_libman, ce_libmaneditor,
+  ce_staticexplorer, ce_miniexplorer, ce_libman, ce_libmaneditor, ce_todolist,
   ce_observer, ce_writableComponent, ce_toolseditor, ce_procinput, ce_cdbcmd;
 
 type
@@ -195,6 +195,7 @@ type
     fLibMWidg: TCELibManEditorWidget;
     fTlsEdWidg: TCEToolsEditorWidget;
     fPrInpWidg: TCEProcInputWidget;
+    fTodolWidg: TCETodoListWidget;
     //fResWidg: TCEResmanWidget;
     {$IFDEF WIN32}
     fCdbWidg: TCECdbWidget;
@@ -465,6 +466,7 @@ begin
   fLibMWidg := TCELibManEditorWidget.create(self);
   fTlsEdWidg:= TCEToolsEditorWidget.create(self);
   fPrInpWidg:= TCEProcInputWidget.create(self);
+  fTodolWidg:= TCETodoListWidget.create(self);
   //fResWidg  := TCEResmanWidget.create(self);
 
   {$IFDEF WIN32}
@@ -481,6 +483,7 @@ begin
   fWidgList.addWidget(@fLibMWidg);
   fWidgList.addWidget(@fTlsEdWidg);
   fWidgList.addWidget(@fPrInpWidg);
+  fWidgList.addWidget(@fTodolWidg);
   //fWidgList.addWidget(@fResWidg);
 
   {$IFDEF WIN32}

src/ce_todolist.lfm

@@ -0,0 +1,94 @@
+inherited CETodoListWidget: TCETodoListWidget
+  Left = 631
+  Height = 337
+  Top = 222
+  Width = 584
+  Caption = 'Todo list'
+  ClientHeight = 337
+  ClientWidth = 584
+  inherited Back: TPanel
+    Height = 337
+    Width = 584
+    ClientHeight = 337
+    ClientWidth = 584
+    inherited Content: TPanel
+      Height = 337
+      Width = 584
+      ClientHeight = 337
+      ClientWidth = 584
+      object Panel1: TPanel[0]
+        Left = 2
+        Height = 26
+        Top = 2
+        Width = 580
+        Align = alTop
+        BorderSpacing.Around = 2
+        BevelOuter = bvNone
+        ClientHeight = 26
+        ClientWidth = 580
+        PopupMenu = contextMenu
+        TabOrder = 0
+        object btnRefresh: TBitBtn
+          Left = 2
+          Height = 22
+          Hint = 'refresh the list'
+          Top = 2
+          Width = 28
+          Align = alLeft
+          BorderSpacing.Around = 2
+          Layout = blGlyphBottom
+          Spacing = 0
+          TabOrder = 0
+        end
+        object lstfilter: TListFilterEdit
+          Left = 38
+          Height = 23
+          Top = 2
+          Width = 513
+          ButtonWidth = 28
+          NumGlyphs = 1
+          Align = alCustom
+          Anchors = [akTop, akLeft, akRight]
+          MaxLength = 0
+          TabOrder = 1
+        end
+      end
+      object lstItems: TListView[1]
+        Left = 4
+        Height = 301
+        Top = 32
+        Width = 576
+        Align = alClient
+        BorderSpacing.Around = 4
+        Columns = <        
+          item
+            Caption = 'text'
+            Width = 250
+          end        
+          item
+            Caption = 'category'
+            Width = 100
+          end        
+          item
+            Caption = 'assignee'
+            Width = 100
+          end        
+          item
+            Caption = 'status'
+            Width = 100
+          end        
+          item
+            Caption = 'priority'
+            Width = 75
+          end>
+        ReadOnly = True
+        TabOrder = 1
+        ViewStyle = vsReport
+      end
+    end
+  end
+  inherited contextMenu: TPopupMenu
+    left = 40
+    top = 72
+  end
+end

src/ce_todolist.pas

@@ -0,0 +1,380 @@
+unit ce_todolist;
+
+{$I ce_defines.inc}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, TreeFilterEdit, ListFilterEdit, Forms, Controls,
+  Graphics, Dialogs, ExtCtrls, Menus, Buttons, StdCtrls, ComCtrls, ce_widget,
+  process, ce_common, ce_interfaces, ce_synmemo, ce_project, ce_symstring;
+
+type
+
+  // represents a TODO item
+  // warning: the props names must be kept in sync with the values set in the tool.
+  TTodoItem = class(TCollectionItem)
+  private
+    fFile: string;
+    fLine: string;
+    fText: string;
+    fPriority: string;
+    fAssignee: string;
+    fCategory: string;
+    fStatus: string;
+  published
+    property filename:string read fFile     write fFile;
+    property line:    string read fLine     write fLine;
+    property text:    string read fText     write fText;
+    property assignee:string read fAssignee write fAssignee;
+    property category:string read fCategory write fCategory;
+    property status:  string read fStatus   write fStatus;
+    property priority:string read fPriority write fPriority;
+  end;
+
+  // encapsulates / makes serializable a collection of TODO item.
+  // warning: the class name must be kept in sync with the value set in the tool.
+  TTodoItems = class(TComponent)
+  private
+    fItems: TCollection;
+    procedure setItems(aValue: TCollection);
+    function getItem(index: Integer): TTodoItem;
+    function getCount: integer;
+  published
+    // warning, "items" must be kept in sync with...
+    property items: TCollection read fItems write setItems;
+  public
+    constructor create(AOwner: TComponent); override;
+    destructor destroy; override;
+    // str will be set on the tool process output.
+    procedure loadFromTxtStream(str: TMemoryStream);
+    property count: integer read getCount;
+    property item[index: integer]: TTodoItem read getItem; default;
+  end;
+
+  { TCETodoListWidget }
+
+  TCETodoListWidget = class(TCEWidget, ICEMultiDocObserver, ICEProjectObserver)
+    btnRefresh: TBitBtn;
+    lstItems: TListView;
+    lstfilter: TListFilterEdit;
+    Panel1: TPanel;
+  private
+    fProj: TCEProject;
+    fDoc: TCESynMemo;
+    fToolProcess: TCheckedAsyncProcess;
+    fTodos: TTodoItems;
+    // ICEMultiDocObserver
+    procedure docNew(aDoc: TCESynMemo);
+    procedure docFocused(aDoc: TCESynMemo);
+    procedure docChanged(aDoc: TCESynMemo);
+    procedure docClosing(aDoc: TCESynMemo);
+    // ICEProjectObserver
+    procedure projNew(aProject: TCEProject);
+    procedure projChanged(aProject: TCEProject);
+    procedure projClosing(aProject: TCEProject);
+    procedure projFocused(aProject: TCEProject);
+    procedure projCompiling(aProject: TCEProject);
+    // TODOlist things
+    procedure killToolProcess;
+    procedure callToolProcess;
+    procedure procTerminated(sender: TObject);
+    procedure procOutput(sender: TObject);
+    procedure clearTodoList;
+    procedure fillTodoList;
+    procedure lstItemsDoubleClick(sender: TObject);
+    procedure btnRefreshClick(sender: TObject);
+    procedure filterItems(sender: TObject);
+  public
+    constructor create(aOwner: TComponent); override;
+    destructor destroy; override;
+  end;
+
+implementation
+{$R *.lfm}
+
+uses
+  ce_main, strutils;
+
+const
+  ToolExeName = 'cetodo' + exeExt;
+
+{$REGION TTodoItems ------------------------------------------------------------}
+constructor TTodoItems.create(aOwner: TComponent);
+begin
+  inherited;
+  fItems := TCollection.Create(TTodoItem);
+end;
+
+destructor TTodoItems.destroy;
+begin
+  fItems.Free;
+  inherited;
+end;
+
+procedure TTodoItems.setItems(aValue: TCollection);
+begin
+  fItems.Assign(aValue);
+end;
+
+function TTodoItems.getItem(index: Integer): TTodoItem;
+begin
+  result := TTodoItem(fItems.Items[index]);
+end;
+
+function TTodoItems.getCount: integer;
+begin
+  result := fItems.Count;
+end;
+
+procedure TTodoItems.loadFromTxtStream(str: TMemoryStream);
+var
+  bin: TMemoryStream;
+begin
+  // empty collection ~ length
+  if str.Size < 50 then exit;
+  //
+  try
+    bin := TMemoryStream.Create;
+    try
+      str.Position:=0;
+      ObjectTextToBinary(str, bin);
+      bin.Position := 0;
+      bin.ReadComponent(self);
+    finally
+      bin.Free;
+    end;
+  except
+    fItems.Clear;
+  end;
+end;
+{$ENDREGIOn}
+
+{$REGION Standard Comp/Obj -----------------------------------------------------}
+constructor TCETodoListWidget.create(aOwner: TComponent);
+var
+  png: TPortableNetworkGraphic;
+begin
+  inherited;
+  fTodos := TTodoItems.Create(self);
+  lstItems.OnDblClick := @lstItemsDoubleClick;
+  btnRefresh.OnClick := @btnRefreshClick;
+
+  // http://bugs.freepascal.org/view.php?id=27137
+  // TODO-cCleanup: remove comment after next Laz release
+  // TODO-cfeature, try the new TListViewFilterEdit here.
+  lstfilter.OnChange:= @filterItems;
+  //
+  png := TPortableNetworkGraphic.Create;
+  try
+    png.LoadFromLazarusResource('arrow_update');
+    btnRefresh.Glyph.Assign(png);
+  finally
+    png.Free;
+  end;
+end;
+
+destructor TCETodoListWidget.destroy;
+begin
+  killToolProcess;
+  inherited;
+end;
+{$ENDREGION}
+
+{$REGION ICEMultiDocObserver ---------------------------------------------------}
+procedure TCETodoListWidget.docNew(aDoc: TCESynMemo);
+begin
+end;
+
+procedure TCETodoListWidget.docFocused(aDoc: TCESynMemo);
+begin
+  fDoc := aDoc;
+  callToolProcess;
+end;
+
+procedure TCETodoListWidget.docChanged(aDoc: TCESynMemo);
+begin
+  if fDoc <> aDoc then exit;
+end;
+
+procedure TCETodoListWidget.docClosing(aDoc: TCESynMemo);
+begin
+  if fDoc <> aDoc then exit;
+  fDoc := nil;
+  callToolProcess;
+end;
+{$ENDREGION}
+
+{$REGION ICEProjectObserver ----------------------------------------------------}
+procedure TCETodoListWidget.projNew(aProject: TCEProject);
+begin
+  fProj := aProject;
+end;
+
+procedure TCETodoListWidget.projChanged(aProject: TCEProject);
+begin
+  if fProj <> aProject then exit;
+  callToolProcess;
+end;
+
+procedure TCETodoListWidget.projClosing(aProject: TCEProject);
+begin
+  if fProj <> aProject then exit;
+  fProj := nil;
+  callToolProcess;
+end;
+
+procedure TCETodoListWidget.projFocused(aProject: TCEProject);
+begin
+  fProj := aProject;
+  callToolProcess;
+end;
+
+procedure TCETodoListWidget.projCompiling(aProject: TCEProject);
+begin
+end;
+{$ENDREGION}
+
+{$REGION Todo list things ------------------------------------------------------}
+procedure TCETodoListWidget.killToolProcess;
+begin
+  if fToolProcess = nil then exit;
+  //
+  fToolProcess.Terminate(0);
+  fToolProcess.Free;
+  fToolProcess := nil;
+end;
+
+procedure TCETodoListWidget.callToolProcess;
+var
+  asProject: boolean;
+begin
+  clearTodoList;
+  if not exeInSysPath(ToolExeName) then exit;
+  if (fDoc = nil) and (fProj = nil)then exit;
+  //
+  if (fProj <> nil) and (fDoc = nil) then asProject := true;
+  if (fProj =  nil) and (fDoc <> nil) then asProject := false;
+  if (fProj <> nil) and (fDoc <> nil) and
+    (fProj.isProjectSource(fDoc.fileName)) then asProject:= true;
+  killToolProcess;
+  // process parameter
+  fToolProcess := TCheckedAsyncProcess.Create(nil);
+  fToolProcess.Executable := ToolExeName;
+  fToolProcess.Options := [poUsePipes, poStderrToOutPut];
+  fToolProcess.ShowWindow := swoHIDE;
+  fToolProcess.OnTerminate := @procTerminated;
+  fToolProcess.OnReadData := @procOutput;
+  // files passed to the tool argument
+  if asProject then fToolProcess.Parameters.Add(symbolExpander.get('<CPFS>'))
+  else fToolProcess.Parameters.AddText(symbolExpander.get('<CFF>'));
+  //
+  fToolProcess.Execute;
+end;
+
+procedure TCETodoListWidget.procOutput(sender: TObject);
+begin
+  // output during run-time
+  // should not be called
+end;
+
+procedure TCETodoListWidget.procTerminated(sender: TObject);
+var
+  str: TMemoryStream;
+  cnt: Integer;
+  sum: Integer;
+const
+  buffSz = 1024;
+begin
+  sum := 0;
+  str := TMemoryStream.Create;
+  try
+    while fToolProcess.Output.NumBytesAvailable <> 0 do begin
+      str.SetSize(sum + buffSz);
+      cnt := fToolProcess.Output.Read((str.Memory + sum)^, buffSz);
+      sum += cnt;
+    end;
+    str.SetSize(sum);
+    str.Position := 0;
+    fTodos.loadFromTxtStream(str);
+    fillTodoList;
+  finally
+    str.Free;
+  end;
+end;
+
+procedure TCETodoListWidget.clearTodoList;
+begin
+  lstItems.Clear;
+  fTodos.items.Clear;
+end;
+
+procedure TCETodoListWidget.fillTodoList;
+var
+  i: integer;
+  src: TTodoItem;
+  trg: TListItem;
+  flt: string;
+begin
+  lstItems.Clear;
+  lstItems.Column[1].Visible:=false;
+  lstItems.Column[2].Visible:=false;
+  lstItems.Column[3].Visible:=false;
+  lstItems.Column[4].Visible:=false;
+  flt := lstfilter.Text;
+  for i:= 0 to fTodos.count -1  do begin
+    src := fTodos[i];
+    trg := lstItems.Items.Add;
+    trg.Data := src;
+    trg.Caption := src.text;
+    trg.SubItems.Add(src.category);
+    trg.SubItems.Add(src.assignee);
+    trg.SubItems.Add(src.status);
+    trg.SubItems.Add(src.priority);
+    //
+    if flt <> '' then if flt <> '(filter)' then
+      if not AnsiContainsText(src.text,flt)     then
+      if not AnsiContainsText(src.category,flt) then
+      if not AnsiContainsText(src.assignee,flt) then
+      if not AnsiContainsText(src.status,flt)   then
+      if not AnsiContainsText(src.priority,flt) then
+    begin
+      lstItems.Items.Delete(trg.Index);
+      continue;
+    end;
+    //
+    if src.category <> '' then lstItems.Column[1].Visible := true;
+    if src.assignee <> '' then lstItems.Column[2].Visible := true;
+    if src.status <> '' then lstItems.Column[3].Visible := true;
+    if src.priority <> '' then lstItems.Column[4].Visible := true;
+  end;
+end;
+
+procedure TCETodoListWidget.lstItemsDoubleClick(sender: TObject);
+var
+  itm: TTodoItem;
+begin
+  if lstItems.Selected = nil then exit;
+  if lstItems.Selected.Data = nil then exit;
+  //
+  itm := TTodoItem(lstItems.Selected.Data);
+  CEMainForm.openFile(itm.filename);
+  //
+  if fDoc = nil then exit;
+  fDoc.CaretY := strToInt(itm.line);
+  fDoc.SelectLine;
+end;
+
+procedure TCETodoListWidget.btnRefreshClick(sender: TObject);
+begin
+  callToolProcess;
+end;
+
+procedure TCETodoListWidget.filterItems(sender: TObject);
+begin
+  fillTodoList
+end;
+
+{$ENDREGION}
+end.
+