added ToDo List from Olivier

git-svn-id: trunk@2907 -

.gitattributes

@@ -229,6 +229,7 @@ ide/splash.lrs svneol=native#text/pascal
 ide/splash.pp svneol=native#text/pascal
 ide/sysvaruseroverridedlg.pas svneol=native#text/pascal
 ide/tcolumndlg1.lfm svneol=native#text/plain
+ide/todolist.pp svneol=native#text/pascal
 ide/transfermacros.pp svneol=native#text/pascal
 ide/unitdependencies.lrs svneol=native#text/pascal
 ide/unitdependencies.pas svneol=native#text/pascal

ide/main.pp

@@ -56,6 +56,7 @@ uses
   IDEOptionDefs, CodeToolsDefines, LocalsDlg, DebuggerDlg, InputHistory,
   DiskDiffsDialog, UnitDependencies, PublishProjectDlg, ClipBoardHistory,
   ProcessList, InitialSetupDlgs, NewDialog, MakeResStrDlg, DiffDialog,
+  ToDoList,
   // main ide
   BaseDebugManager, DebugManager, MainBar;
 
@@ -156,6 +157,7 @@ type
     procedure mnuAddToProjectClicked(Sender : TObject);
     procedure mnuRemoveFromProjectClicked(Sender : TObject);
     procedure mnuViewProjectSourceClicked(Sender : TObject);
+    procedure mnuViewProjectTodosClicked(Sender : TObject);
     procedure mnuProjectOptionsClicked(Sender : TObject);
     
     // run menu
@@ -285,6 +287,10 @@ type
     procedure UnitDependenciesViewOpenFile(Sender: TObject;
       const Filename: string);
 
+    // view project ToDo list events
+    procedure ViewProjectTodosOpenFile(Sender: TObject;
+      const Filename: string);
+
     // CodeToolBoss events
     procedure OnBeforeCodeToolBossApplyChanges(Manager: TCodeToolManager;
                                     var Abort: boolean);
@@ -442,6 +448,7 @@ type
     function SomethingOfProjectIsModified: boolean;
     function DoCreateProjectForProgram(ProgramBuf: TCodeBuffer): TModalResult;
     function DoSaveProjectToTestDirectory: TModalResult;
+    function DoShowToDoList: TModalResult;
     
     // edit menu
     procedure DoEditMenuCommand(EditorCommand: integer);
@@ -1458,6 +1465,7 @@ begin
   itmProjectAddTo.OnClick := @mnuAddToProjectClicked;
   itmProjectRemoveFrom.OnClick := @mnuRemoveFromProjectClicked;
   itmProjectViewSource.OnClick := @mnuViewProjectSourceClicked;
+  itmProjectViewToDos.OnClick := @mnuViewProjectTodosClicked;
   itmProjectOptions.OnClick := @mnuProjectOptionsClicked;
 end;
 
@@ -2182,6 +2190,11 @@ begin
   DoOpenMainUnit(false);
 end;
 
+procedure TMainIDE.mnuViewProjectTodosClicked(Sender: TObject);
+begin
+  DoShowToDoList;
+end;
+
 procedure TMainIDE.mnuProjectOptionsClicked(Sender : TObject);
 var
   ActiveSrcEdit: TSourceEditor;
@@ -5179,6 +5192,20 @@ begin
   Result:=DoSaveProject([sfSaveToTestDir,sfCheckAmbigiousFiles]);
 end;
 
+function TMainIDE.DoShowToDoList: TModalResult;
+begin
+  if not Assigned(frmToDo) then begin
+    frmToDo:=TfrmToDo.Create(Self);
+    frmToDo.OnOpenFile:=@ViewProjectTodosOpenFile;
+  end;
+
+  frmToDo.FileName:=Project1.MainUnitInfo.Filename;
+
+  frmToDo.Show;
+  BringWindowToTop(frmToDo.Handle);
+  Result:=mrOk;
+end;
+
 function TMainIDE.DoBuildProject(BuildAll: boolean): TModalResult;
 var
   DefaultFilename: string;
@@ -6412,6 +6439,12 @@ begin
   DoOpenEditorFile(Filename,-1,[]);
 end;
 
+procedure TMainIDE.ViewProjectTodosOpenFile(Sender: TObject;
+  const Filename: string);
+begin
+  DoOpenEditorFile(Filename,-1,[]);
+end;
+
 // -----------------------------------------------------------------------------
 
 procedure TMainIDE.InitCodeToolBoss;
@@ -8026,6 +8059,9 @@ end.
 
 { =============================================================================
   $Log$
+  Revision 1.498  2003/03/26 10:56:30  mattias
+  added ToDo List from Olivier
+
   Revision 1.497  2003/03/26 00:21:24  mattias
   implemented build lazarus extra options -d
 

ide/todolist.pp

@@ -0,0 +1,601 @@
+(*
+/***************************************************************************
+                             todolist.pp
+                             --------------------
+
+ ***************************************************************************/
+
+ ***************************************************************************
+ *                                                                         *
+ *   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: Olivier GUILBAUD <golivier@free.fr>
+
+  Abstract:
+    List all to do comments of current project.
+    
+    the todo comments has this syntax
+      {#todoxxx yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy}
+      or
+      //#todoxxx yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy
+      or
+      (.*#todoxxx yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy *.) (delete the .)
+      
+    where  xxx     is the priority
+           yyy..yy is the text of todo
+           
+   you can create an file naming projectname.todo and add list of todo
+*)
+
+{#todo goto line of selected unit}
+{#todo options }
+{#todo print an todo report }
+
+unit TodoList;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources,
+  ExtCtrls, ComCtrls, Menus, Buttons, GraphType,
+  StdCtrls, mPasLex, LCLLinux, LCLType,
+  CodeCache, CodeToolManager, LazarusIDEStrConsts;
+
+Const
+  cTodoFlag = '#todo';
+  
+type
+  TOnOpenFile = procedure(Sender: TObject; const Filename: string) of object;
+
+  TfrmToDo = class(TForm)
+    StatusBar:TStatusBar;
+    lvTodo:TListView;
+  private
+    { private declarations }
+    fBuild       : Boolean;
+    fFileName    : String;
+    FOnOpenFile  : TOnOpenFile;
+    fRootCBuffer : TCodeBuffer;
+    fScannedFile : TStringList;
+
+    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift:TShiftState);
+    procedure SetFileName(const AValue: String);
+    
+    procedure actFileRefresh(Sender : TObject);
+    procedure actEditGoto(Sender : TObject);
+    procedure actFilePrint(Sender : TObject);
+    procedure actOptionsCfg(Sender : TObject);
+    
+    procedure ParseComment(const aFileName: string; const SComment, EComment: string;
+        const TokenString: string; LineNumber: Integer);
+    procedure ParseDirective(aDirective : String);
+    
+    procedure LoadFile(const aFileName : string);
+  public
+    { public declarations }
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    property FileName : String read fFileName write SetFileName;
+    property OnOpenFile: TOnOpenFile read FOnOpenFile write FOnOpenFile;
+  end;
+
+var
+  frmToDo: TfrmToDo;
+
+implementation
+
+
+Type
+   PCharArray   = Array[0..16+5] of PChar;
+const
+  //Images of ToolBar
+  cImg_ToDoRefresh : PCharArray=
+  ('16 16 5 1',
+   '. c None',
+   '# c #303030',
+   'a c #58a8ff',
+   ' ',
+   ' ',
+   '................',
+   '................',
+   '................',
+   '.......######...',
+   '.....##aaa####..',
+   '....##aa###.....',
+   '....#aa#........',
+   '...##aa#........',
+   '...#aa#.........',
+   '...#aa#.........',
+   '...#aa#.........',
+   '.##aaa####......',
+   '..#aaaaa#.......',
+   '...##a##........',
+   '....###.........',
+   '.....#..........');
+   
+  cImg_ToDoGotoLine : PCharArray=
+  ('16 16 5 1',
+   '. c None',
+   '# c #303030',
+   'b c #ff0000',
+   'a c #ffffff',
+   ' ',
+   '................',
+   '................',
+   '...#######......',
+   '...#aaaaaa#.....',
+   '...#aaaaaaa#....',
+   '...#aaaaaaaa#...',
+   '...#aaaaaaaa#...',
+   '...#aaaaaaaa#...',
+   '.b.#aaaaaaaa#...',
+   '..bbbbbbbbbbb...',
+   '.b.#aaaaaaaa#...',
+   '...#aaaaaaaa#...',
+   '...#aaaaaaaa#...',
+   '...##########...',
+   '................',
+   '................');
+   
+   cImg_ToDoOptions : PCharArray=
+   ('16 16 5 1',
+    '. c None',
+    'a c #0058c0',
+    '# c #303030',
+    'c c #ff0000',
+    'b c #ffffff',
+    '................',
+    '.##############.',
+    '.#aaaaaaaaaaaa#.',
+    '.##############.',
+    '.#bbbbbbbbbbbb#.',
+    '.#bcbbbccbbbbb#.',
+    '.#bccbccbbbbbb#.',
+    '.#bbcccbbbbbbb#.',
+    '.#bbbcbbbbbbbb#.',
+    '.#bcbbbccbbbbb#.',
+    '.#bccbccbbbbbb#.',
+    '.#bbcccbbbbbbb#.',
+    '.#bbbcbbbbbbbb#.',
+    '.#bbbbbbbbbbbb#.',
+    '.##############.',
+    '................');
+    
+    cImg_ToDoPrint : PCharArray=
+    ('16 16 5 1',
+     '. c None',
+     'e c #00ff00',
+     '# c #303030',
+     'c c #808080',
+     'b c #c3c3c3',
+     'd c #ff0000',
+     'a c #ffffff',
+     '................',
+     '................',
+     '.......#######..',
+     '......#aaaaa#...',
+     '.....#aaaaa#....',
+     '....#aaaaa#####.',
+     '...########bb##.',
+     '..#bbbbbbbbb#c#.',
+     '..##########cc#.',
+     '..#bdbebbb#cc##.',
+     '..############..',
+     '..#bbbbbbbb##...',
+     '...#########....',
+     '................');
+
+
+{ TfrmToDo }
+
+constructor TfrmToDo.Create(AOwner: TComponent);
+var C   : TListColumn;
+    Btn : TSpeedButton;
+    Bar :TPanel;
+    Bmp : TBitMap;
+    
+  procedure AssignResImg(SpdBtn: TSpeedButton; const ResName: string);
+  Var PixM : TBitMap;
+  begin
+    if LazarusResources.Find(ResName)<>nil then
+    begin
+      PixM:=TBitMap.Create;
+      try
+        PixM.LoadFromLazarusResource(ResName);
+        SpdBtn.Glyph.Assign(PixM);
+      finally
+        PixM.Free;
+      end;
+    end;
+  end;
+
+begin
+  inherited Create(AOwner);
+  fBuild:=False;
+  fScannedFile:=TStringList.Create;
+  Left := 456;
+  Top := 116;
+  Width := 477;
+  Height := 307;
+  Caption := dlgTodoListCaption;
+  KeyPreview := True;
+  Position := poScreenCenter;
+  OnKeyDown  :={$IFDEF FPC}@{$ENDIF}FormKeyDown;
+
+  StatusBar:=TStatusBar.Create(Self);
+  with StatusBar do
+  begin
+    parent:=self;
+    Left := 0;
+    Top := 259;
+    Width := 469;
+    Height := 19;
+    SimplePanel := True;
+  end;
+
+  //Tool bar
+  Bar:=TPanel.Create(Self);
+  with Bar do
+  begin
+    parent:=self;
+    Left := 0;
+    Top := 0;
+    Height := 22;
+    Caption := '';
+    Align:=alTop;
+    ParentShowHint:=False;
+    BevelOuter:=bvNone;
+    BevelInner:=bvNone;
+  end;
+
+  //Button refresh
+  Btn:=TSpeedButton.Create(Bar);
+  btn.Parent:=Bar;
+  Btn.Flat  :=True;
+  Btn.Width :=20;
+  Btn.Height:=20;
+  Btn.Left  :=0;
+  Btn.Top   :=0;
+  Bmp:=TBitMap.Create;
+  Bmp.Handle:=CreatePixmapIndirect(@cImg_ToDoRefresh[0], GetSysColor(COLOR_BTNFACE));
+  Btn.Glyph:=Bmp;
+  Btn.ShowHint:=True;
+  Btn.Hint  := dlgTodolistRefresh;
+  Btn.OnClick:={$IFDEF FPC}@{$ENDIF}actFileRefresh;
+
+  //button Goto
+  Btn:=TSpeedButton.Create(Bar);
+  btn.Parent:=Bar;
+  Btn.Flat  :=True;
+  Btn.Width :=20;
+  Btn.Height:=20;
+  Btn.Left  :=22;
+  Btn.Top   :=0;
+  Btn.ShowHint:=True;
+  Bmp:=TBitMap.Create;
+  Bmp.Handle:=CreatePixmapIndirect(@cImg_ToDoGotoLine[0], GetSysColor(COLOR_BTNFACE));
+  Btn.Glyph:=Bmp;
+  Btn.Hint  := dlgtodoListGotoLine;
+  Btn.OnClick:={$IFDEF FPC}@{$ENDIF}actEditGoto;
+
+  //button Print
+  Btn:=TSpeedButton.Create(Bar);
+  btn.Parent:=Bar;
+  Btn.Flat  :=True;
+  Btn.Width :=20;
+  Btn.Height:=20;
+  Btn.Left  :=42;
+  Btn.Top   :=0;
+  Btn.ShowHint:=True;
+  Btn.Hint   :=dlgtodoListPrintList;
+  Bmp:=TBitMap.Create;
+  Bmp.Handle:=CreatePixmapIndirect(@cImg_ToDoPrint[0], GetSysColor(COLOR_BTNFACE));
+  Btn.Glyph:=Bmp;
+  Btn.OnClick:={$IFDEF FPC}@{$ENDIF}actFilePrint;
+
+  //button Options
+  Btn:=TSpeedButton.Create(Bar);
+  btn.Parent:=Bar;
+  Btn.Flat  :=True;
+  Btn.Width :=20;
+  Btn.Height:=20;
+  Btn.Left  :=62;
+  Btn.Top   :=0;
+  Btn.ShowHint:=True;
+  Bmp:=TBitMap.Create;
+  Bmp.Handle:=CreatePixmapIndirect(@cImg_ToDoOptions[0], GetSysColor(COLOR_BTNFACE));
+  Btn.Glyph:=Bmp;
+  Btn.Hint  :=  dlgToDoListOptions;
+  Btn.OnClick:={$IFDEF FPC}@{$ENDIF}actOptionsCfg;
+
+
+  lvTodo:=TListView.Create(Self);
+  with lvTodo do
+  begin
+    parent:=self;
+    Left := 0;
+    Top := 22;
+    Width := 469;
+    Height := 237;
+    Align := alClient;
+    ViewStyle:=vsReport;
+    lvToDo.OnDblClick:={$IFDEF FPC}@{$ENDIF}actEditGoto;
+    //priority column
+    C:=Columns.Add;
+    C.Caption := ' !';
+    C.Width   := 15;
+    //Description column
+    C:=Columns.Add;
+    C.Caption := 'Description';
+    C.Width   := 250;
+    //File column
+    C:=Columns.Add;
+    C.Caption := 'File';
+    C.Width := 150;
+    //Line column
+    C:=Columns.Add;
+    C.Caption := 'Line';
+    C.Width := 28;
+  end;
+
+  ActiveControl := lvTodo;
+end;
+
+destructor TfrmToDo.Destroy;
+begin
+  fScannedFile.Free;
+
+  inherited Destroy;
+end;
+
+//Load project and scan all files for find the syntax todo
+procedure TfrmToDo.actFileRefresh(Sender: TObject);
+var
+  UsedInterfaceFilenames,
+  UsedImplementationFilenames: TStrings;
+  i: integer;
+  St : String;
+begin
+  if fBuild then Exit;
+  
+  Screen.Cursor:=crHourGlass;
+  Try
+    fBuild:=True;
+    lvTodo.Items.Clear;
+    fScannedFile.Clear;
+    //Find an '.todo' filename
+    St:=ChangeFileExt(fFileName,'.todo');
+    If FileExists(St) then
+      LoadFile(St);
+
+    //Load project file
+    LoadFile(fFileName);
+
+
+    if Assigned(CodeToolBoss) then
+    begin
+      fRootCBuffer:=CodeToolBoss.LoadFile(fFileName,false,false);
+      if not Assigned(fRootCBuffer) then Exit;
+
+      if CodeToolBoss.FindUsedUnits(fRootCBuffer,UsedInterfaceFilenames,
+                                    UsedImplementationFilenames) then
+      begin
+        try
+          for i:=0 to UsedInterfaceFilenames.Count-1 do
+            LoadFile(UsedInterfaceFilenames[i]);
+
+          for i:=0 to UsedImplementationFilenames.Count-1 do
+            LoadFile(UsedImplementationFilenames[i]);
+        finally
+          UsedImplementationFilenames.Free;
+          UsedInterfaceFilenames.Free;
+        end;
+      end;
+    end;
+  finally
+    Screen.Cursor:=crDefault;
+    fBuild:=False;
+  end;
+end;
+
+procedure TfrmToDo.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+  if Key=VK_ESCAPE then
+    Close;
+end;
+
+//Initialise then todo project and find them
+procedure TfrmToDo.SetFileName(const AValue: String);
+begin
+  if fFileName=AValue then exit;
+  fFileName:=AValue;
+  actFileRefresh(nil);
+end;
+
+procedure TfrmToDo.actEditGoto(Sender: TObject);
+var
+  CurFilename: String;
+begin
+  showMessage('not implemented');
+  exit;
+  CurFilename:='';
+  if Assigned(OnOpenFile) then OnOpenFile(Self,CurFilename);
+end;
+
+procedure TfrmToDo.actFilePrint(Sender: TObject);
+begin
+  //showMessage('not implemented');
+end;
+
+procedure TfrmToDo.actOptionsCfg(Sender: TObject);
+begin
+  //showMessage('not implemented');
+end;
+
+//Find the {$I filename} directive. If exists, call LoadFile()
+procedure TfrmToDo.ParseDirective(aDirective : String);
+Var N             : Integer;
+    ParsingString : string;
+begin
+  N:=Pos('{$I ',UpperCase(aDirective));
+  if N<>0 then
+  begin
+    //we found a token that look a include directive. now extract
+    //the file name
+    ParsingString:=Trim(Copy(aDirective,N+Length('{$I '),MaxInt));
+    ParsingString:=Trim(Copy(ParsingString,1,Pos('}',ParsingString)-1));
+    // ToDo: search in include path
+    LoadFile(ParsingString);
+  end;
+end;
+
+//Find in comment the ToDo message
+procedure TfrmToDo.ParseComment(const aFileName: string; const SComment, EComment: string;
+  const TokenString: string; LineNumber: Integer);
+Var
+  N,J           : Integer;
+  ParsingString : string;
+  CListItem     : TListItem;
+begin
+  N:=Pos(UpperCase(cTodoFlag),UpperCase(TokenString));
+  if N>1 then
+  begin
+    // We found a token that looks like a TODO comment. Now
+    // verify that it *is* one: either a white-space or the
+    // comment token need to be right in front of the TODO item
+
+    // Remove comment characters
+    ParsingString := TokenString;
+    Delete(ParsingString, 1, Length(SComment));
+
+    // Remove white-space left and right
+    ParsingString := Trim(ParsingString);
+
+    // The TODO token should be at the beginning of the comment
+    N:=Pos(UpperCase(cTodoFlag),UpperCase(ParsingString));
+    if N=1 then
+    begin
+      // Remove token from string
+      Delete(ParsingString, 1, Length(cTodoFlag));
+      ParsingString := TrimRight(ParsingString);
+
+      if EComment<>'' then
+      begin
+        N:=Pos(EComment,ParsingString);
+        // Remove end comment from string
+        Delete(ParsingString, N, Length(EComment));
+        ParsingString := TrimRight(ParsingString);
+      end;
+
+      CListItem := lvToDo.Items.Add;
+
+      // Identify numeric priority (if there is one)
+      j := 0;
+      while j < Length(ParsingString) do
+      begin
+        if not (ParsingString[j + 1] in ['0'..'9']) then
+          Break;
+        Inc(j);
+      end;
+      N:=StrToIntDef(Copy(ParsingString, 1, j), 0);
+      ClistItem.Caption:=IntToStr(N);
+      Delete(ParsingString, 1, j);
+      ParsingString := TrimLeft(ParsingString);
+
+      ClistItem.SubItems.Add(ParsingString);
+      ClistItem.SubItems.Add(ExtractFileName(aFileName));
+      ClistItem.SubItems.Add(IntToStr(LineNumber));
+     // CListItem.ImageIndex := Ord(Info.Priority);
+    end;
+  end;
+end;
+
+//Load an FileName and find {#todox yyyyyy} where
+// x is the priority (0 by default)
+// yyyy it's the message one line only
+procedure TfrmToDo.LoadFile(const aFileName: string);
+var
+  Parser   : TmwPasLex;
+  FlStream : TFileStream;
+  EStream  : TMemoryStream;
+  Err      : Boolean;
+  ST       : String;
+begin
+  St:=ExtractFileName(aFileName);
+  //Quit this method if we have already scan this file
+  if fScannedFile.IndexOf(St)<>-1 then Exit;
+  StatusBar.SimpleText :=aFileName;// St;
+  StatusBar.Repaint;
+  fScannedFile.Add(St);
+
+  EStream := TMemoryStream.Create;
+  try
+    //Echange of stream
+    Try
+      Err:=False;
+      FlStream := TFileStream.Create(aFileName,fmOpenReadWrite);
+      try
+        EStream.LoadFromStream(FlStream)
+      finally
+        FlStream.Free;
+      end;
+    Except
+      Err:=True;
+    end;
+
+    if Err then Exit;
+
+    EStream.Position := 0;
+
+    Parser := TmwPasLex.Create;
+    try
+      Parser.Origin := EStream.Memory;
+      while Parser.TokenID <> tkNull do
+      begin
+        { TODO 3 -oStefan -cIssue: This needs to be fixed for multiline comments;
+          the strategy ought to be to read the complete comment and only then
+          start parsing. Also it would be better to move deleting of the comment
+          tokens out of the parser }
+        case Parser.TokenID of
+          tkBorComment: ParseComment(aFileName, '{', '}', Parser.Token, Parser.LineNumber + 1);
+          tkAnsiComment: ParseComment(aFileName, '(*', '*)', Parser.Token, Parser.LineNumber + 1);
+          // Slash comments in CPP files should work if they are not in a {}
+          tkSlashesComment: ParseComment(aFileName, '//', '', Parser.Token, Parser.LineNumber + 1);
+          tkCompDirect : ParseDirective(Parser.Token);
+        end;
+        Parser.Next;
+      end;
+    finally
+      Parser.Free;
+    end;
+  finally
+    EStream.Free;
+    Self.Update;
+  end;
+end;
+
+
+initialization
+  {.$I ufrmtodo.lrs}
+  
+end.
+