paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-13 21:19:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

ToDoList: Add a button for editing the selected item in a dialog.

Browse Source
This commit is contained in:
Juha 2025-06-25 19:56:46 +03:00
parent 4f879177e7
commit 87f0aec570
6 changed files with 283 additions and 189 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
components/todolist/tododlg.lfm
View File

@ -20,7 +20,7 @@ object TodoDialog: TTodoDialog
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner AnchorSideTop.Control = Owner
Left = 8 Left = 8
Height = 19 Height = 18
Top = 4 Top = 4
Width = 29 Width = 29
BorderSpacing.Left = 8 BorderSpacing.Left = 8
@ -35,9 +35,9 @@ object TodoDialog: TTodoDialog
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = PriorityEdit AnchorSideBottom.Control = PriorityEdit
Left = 8 Left = 8
Height = 19 Height = 18
Top = 93 Top = 95
Width = 46 Width = 45
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
@ -48,8 +48,8 @@ object TodoDialog: TTodoDialog
AnchorSideLeft.Control = OwnerEdit AnchorSideLeft.Control = OwnerEdit
AnchorSideBottom.Control = OwnerEdit AnchorSideBottom.Control = OwnerEdit
Left = 74 Left = 74
Height = 19 Height = 18
Top = 91 Top = 95
Width = 43 Width = 43
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -61,9 +61,9 @@ object TodoDialog: TTodoDialog
AnchorSideLeft.Control = CategoryEdit AnchorSideLeft.Control = CategoryEdit
AnchorSideBottom.Control = CategoryEdit AnchorSideBottom.Control = CategoryEdit
Left = 235 Left = 235
Height = 19 Height = 18
Top = 91 Top = 95
Width = 58 Width = 56
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
@ -78,8 +78,8 @@ object TodoDialog: TTodoDialog
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = PriorityLabel AnchorSideBottom.Control = PriorityLabel
Left = 8 Left = 8
Height = 64 Height = 67
Top = 25 Top = 24
Width = 381 Width = 381
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
ScrollBars = ssAutoBoth ScrollBars = ssAutoBoth
@ -92,8 +92,8 @@ object TodoDialog: TTodoDialog
AnchorSideRight.Control = Bevel2 AnchorSideRight.Control = Bevel2
AnchorSideBottom.Control = grpboxToDoType AnchorSideBottom.Control = grpboxToDoType
Left = 74 Left = 74
Height = 31 Height = 32
Top = 112 Top = 115
Width = 153 Width = 153
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
@ -108,8 +108,8 @@ object TodoDialog: TTodoDialog
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = grpboxToDoType AnchorSideBottom.Control = grpboxToDoType
Left = 235 Left = 235
Height = 31 Height = 32
Top = 112 Top = 115
Width = 154 Width = 154
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Right = 8 BorderSpacing.Right = 8
@ -119,8 +119,8 @@ object TodoDialog: TTodoDialog
object BtnPanel: TButtonPanel object BtnPanel: TButtonPanel
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 34 Height = 29
Top = 250 Top = 255
Width = 385 Width = 385
OKButton.Name = 'OKButton' OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True OKButton.DefaultCaption = True
@ -139,8 +139,8 @@ object TodoDialog: TTodoDialog
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = grpboxToDoType AnchorSideBottom.Control = grpboxToDoType
Left = 8 Left = 8
Height = 29 Height = 32
Top = 114 Top = 115
Width = 58 Width = 58
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
@ -150,18 +150,18 @@ object TodoDialog: TTodoDialog
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 8 Left = 8
Height = 66 Height = 66
Top = 151 Top = 155
Width = 381 Width = 381
Align = alBottom Align = alBottom
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Right = 8 BorderSpacing.Right = 8
Caption = 'ToDo type' Caption = 'ToDo type'
ClientHeight = 46 ClientHeight = 36
ClientWidth = 379 ClientWidth = 377
TabOrder = 4 TabOrder = 4
object rdoToDo: TRadioButton object rdoToDo: TRadioButton
Left = 6 Left = 6
Height = 21 Height = 22
Top = 0 Top = 0
Width = 56 Width = 56
BorderSpacing.Left = 6 BorderSpacing.Left = 6
@ -177,9 +177,9 @@ object TodoDialog: TTodoDialog
AnchorSideLeft.Control = grpboxToDoType AnchorSideLeft.Control = grpboxToDoType
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
Left = 162 Left = 162
Height = 21 Height = 22
Top = 0 Top = 0
Width = 58 Width = 57
Anchors = [akTop] Anchors = [akTop]
Caption = 'Done' Caption = 'Done'
TabOrder = 1 TabOrder = 1
@ -189,10 +189,10 @@ object TodoDialog: TTodoDialog
Tag = 2 Tag = 2
AnchorSideRight.Control = grpboxToDoType AnchorSideRight.Control = grpboxToDoType
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 318 Left = 317
Height = 21 Height = 22
Top = 0 Top = 0
Width = 55 Width = 54
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 6 BorderSpacing.Right = 6
Caption = 'Note' Caption = 'Note'
@ -203,8 +203,8 @@ object TodoDialog: TTodoDialog
object chkAlternateTokens: TCheckBox object chkAlternateTokens: TCheckBox
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 8 Left = 8
Height = 21 Height = 22
Top = 223 Top = 227
Width = 381 Width = 381
Align = alBottom Align = alBottom
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]

102
components/todolist/tododlg.pas
View File

@ -78,11 +78,15 @@ var
ViewToDoListCmd: TIDECommand; ViewToDoListCmd: TIDECommand;
procedure Register; procedure Register;
procedure InsertToDoForActiveSourceEditor(Sender: TObject); // ToDo List
procedure ViewToDoList(Sender: TObject); procedure ViewToDoList(Sender: TObject);
procedure CreateIDEToDoWindow(Sender: TObject; aFormName: string; procedure CreateIDEToDoWindow(Sender: TObject; aFormName: string;
var AForm: TCustomForm; DoDisableAutoSizing: boolean); var AForm: TCustomForm; DoDisableAutoSizing: boolean);
function ExecuteTodoDialog: TTodoItem; // ToDo Dialog
function ExecuteTodoDialog(const aCaption: string; var aTodoItem: TTodoItem): TModalResult;
procedure InsertToDoForActiveSourceEditor(Sender: TObject);
procedure EditToDo(aTodoItem: TTodoItem);
implementation implementation
@ -137,23 +141,6 @@ begin
IDEWindowCreators.Add(ToDoWindowName,@CreateIDEToDoWindow,nil,'250','250','',''); IDEWindowCreators.Add(ToDoWindowName,@CreateIDEToDoWindow,nil,'250','250','','');
end; end;
procedure InsertToDoForActiveSourceEditor(Sender: TObject);
var
SrcEdit: TSourceEditorInterface;
aTodoItem: TTodoItem;
begin
SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
if SrcEdit=nil then exit;
if SrcEdit.ReadOnly then exit;
aTodoItem := ExecuteTodoDialog;
try
if Assigned(aTodoItem) then
SrcEdit.Selection:=aTodoItem.AsComment;
finally
aTodoItem.Free;
end;
end;
procedure ViewToDoList(Sender: TObject); procedure ViewToDoList(Sender: TObject);
var var
Pkg: TIDEPackage; Pkg: TIDEPackage;
@ -171,41 +158,92 @@ end;
procedure CreateIDEToDoWindow(Sender: TObject; aFormName: string; procedure CreateIDEToDoWindow(Sender: TObject; aFormName: string;
var AForm: TCustomForm; DoDisableAutoSizing: boolean); var AForm: TCustomForm; DoDisableAutoSizing: boolean);
begin begin
if CompareText(aFormName,ToDoWindowName)<>0 then exit; Assert(aFormName=ToDoWindowName, 'CreateIDEToDoWindow: aFormName<>ToDoWindowName');
IDEWindowCreators.CreateForm(IDETodoWindow,TIDETodoWindow,DoDisableAutoSizing, IDEWindowCreators.CreateForm(IDETodoWindow,TIDETodoWindow,DoDisableAutoSizing,
LazarusIDE.OwningComponent); LazarusIDE.OwningComponent);
IDETodoWindow.OnEditItem:=@EditToDo; // Edit the selected ToDo item.
AForm:=IDETodoWindow; AForm:=IDETodoWindow;
end; end;
function ExecuteTodoDialog: TTodoItem; function ExecuteTodoDialog(const aCaption: string; var aTodoItem: TTodoItem): TModalResult;
var var
aTodoDialog: TTodoDialog; aTodoDialog: TTodoDialog;
begin begin
Result := nil;
aTodoDialog := TTodoDialog.Create(nil); aTodoDialog := TTodoDialog.Create(nil);
aTodoDialog.Caption:=aCaption;
if Assigned(aTodoItem) then begin
aTodoDialog.CategoryEdit.Text := aTodoItem.Category;
aTodoDialog.grpboxToDoType.Tag := PtrInt(aTodoItem.ToDoType);
case aTodoItem.ToDoType of
tdToDo: aTodoDialog.rdoToDo.Checked := True;
tdDone: aTodoDialog.rdoDone.Checked := True;
tdNote: aTodoDialog.rdoNote.Checked := True;
end;
aTodoDialog.chkAlternateTokens.Checked := aTodoItem.TokenStyle=tsAlternate;
aTodoDialog.OwnerEdit.Text := aTodoItem.Owner;
aTodoDialog.TodoMemo.Text := aTodoItem.Text;
aTodoDialog.PriorityEdit.Value := aTodoItem.Priority;
end;
aTodoDialog.ShowModal; aTodoDialog.ShowModal;
if aTodoDialog.ModalResult = mrOk then Result := aTodoDialog.ModalResult;
if Result = mrOk then
begin begin
Result := TTodoItem.Create; if aTodoItem=nil then begin
Result.Category := aTodoDialog.CategoryEdit.Text; aTodoItem := TTodoItem.Create;
Result.ToDoType := TToDoType(aTodoDialog.grpboxToDoType.Tag); aTodoItem.CommentType := '{';
aTodoItem.HasColon := True;
end;
aTodoItem.Category := aTodoDialog.CategoryEdit.Text;
aTodoItem.ToDoType := TToDoType(aTodoDialog.grpboxToDoType.Tag);
if aTodoDialog.chkAlternateTokens.Checked then if aTodoDialog.chkAlternateTokens.Checked then
Result.TokenStyle:=tsAlternate aTodoItem.TokenStyle:=tsAlternate
else else
Result.TokenStyle:=tsNormal; aTodoItem.TokenStyle:=tsNormal;
Result.Owner := aTodoDialog.OwnerEdit.Text; aTodoItem.Owner := aTodoDialog.OwnerEdit.Text;
Result.Text := aTodoDialog.TodoMemo.Text; aTodoItem.Text := aTodoDialog.TodoMemo.Text;
Result.Priority := aTodoDialog.PriorityEdit.Value; aTodoItem.Priority := aTodoDialog.PriorityEdit.Value;
end; end;
aTodoDialog.Free; aTodoDialog.Free;
end; end;
procedure InsertToDoForActiveSourceEditor(Sender: TObject);
var
SrcEdit: TSourceEditorInterface;
TodoItem: TTodoItem;
begin
SrcEdit := SourceEditorManagerIntf.ActiveEditor;
if (SrcEdit=nil) or SrcEdit.ReadOnly then exit;
TodoItem := nil;
if ExecuteTodoDialog(lisTDDInsertToDo, TodoItem) <> mrOK then exit;
try
if Assigned(TodoItem) then
SrcEdit.Selection := TodoItem.AsComment;
finally
TodoItem.Free;
end;
IDETodoWindow.UpdateTodos;
end;
procedure EditToDo(aTodoItem: TTodoItem);
var
SrcEdit: TSourceEditorInterface;
EndPos: TPoint;
begin
SrcEdit := SourceEditorManagerIntf.ActiveEditor;
if (SrcEdit=nil) or SrcEdit.ReadOnly then exit;
if ExecuteTodoDialog(lisTDDEditToDo, aTodoItem) <> mrOK then exit;
EndPos.X := aTodoItem.CodePos.X + aTodoItem.CommentLen;
EndPos.Y := aTodoItem.CodePos.Y; // ToDo -oJuha : Deal with multiline comments.
SrcEdit.SelectText(aTodoItem.CodePos, EndPos);
SrcEdit.Selection := aTodoItem.AsComment;
IDETodoWindow.UpdateTodos; { TODO -oJuha : Retain selection in the list. }
end;
{ TTodoDialog } { TTodoDialog }
procedure TTodoDialog.FormCreate(Sender: TObject); procedure TTodoDialog.FormCreate(Sender: TObject);
begin begin
ActiveControl:=TodoMemo; ActiveControl:=TodoMemo;
Caption:=lisTDDInsertToDo;
TodoLabel.Caption:=lisPkgFileTypeText; TodoLabel.Caption:=lisPkgFileTypeText;
PriorityLabel.Caption:=lisToDoLPriority; PriorityLabel.Caption:=lisToDoLPriority;
OwnerLabel.Caption:=lisToDoLOwner; OwnerLabel.Caption:=lisToDoLOwner;

136
components/todolist/todolist.lfm
View File

@ -14,7 +14,7 @@ object IDETodoWindow: TIDETodoWindow
OnCloseQuery = FormCloseQuery OnCloseQuery = FormCloseQuery
OnCreate = FormCreate OnCreate = FormCreate
OnKeyDown = FormKeyDown OnKeyDown = FormKeyDown
OnShow = DoUpdateToDos OnShow = acRefreshExecute
object lvTodo: TListView object lvTodo: TListView
Left = 6 Left = 6
Height = 176 Height = 176
@ -29,7 +29,7 @@ object IDETodoWindow: TIDETodoWindow
item item
AutoSize = True AutoSize = True
Caption = 'Type' Caption = 'Type'
Width = 40 Width = 100
end end
item item
Caption = 'Description' Caption = 'Description'
@ -38,26 +38,27 @@ object IDETodoWindow: TIDETodoWindow
item item
AutoSize = True AutoSize = True
Caption = 'Priority' Caption = 'Priority'
Width = 53 Width = 100
end end
item item
AutoSize = True AutoSize = True
Caption = 'Module' Caption = 'Module'
Width = 56 Width = 100
end end
item item
AutoSize = True AutoSize = True
Caption = 'Line' Caption = 'Line'
Width = 37 Width = 100
end end
item item
AutoSize = True AutoSize = True
Caption = 'Owner' Caption = 'Owner'
Width = 100
end end
item item
AutoSize = True AutoSize = True
Caption = 'Category' Caption = 'Category'
Width = 63 Width = 100
end> end>
ReadOnly = True ReadOnly = True
RowSelect = True RowSelect = True
@ -81,10 +82,10 @@ object IDETodoWindow: TIDETodoWindow
ShowCaptions = True ShowCaptions = True
ShowHint = True ShowHint = True
TabOrder = 0 TabOrder = 0
object tbRefresh: TToolButton object tbEdit: TToolButton
Left = 1 Left = 1
Top = 2 Top = 2
Action = acRefresh Action = acEdit
AutoSize = True AutoSize = True
end end
object tbGoto: TToolButton object tbGoto: TToolButton
@ -93,26 +94,34 @@ object IDETodoWindow: TIDETodoWindow
Action = acGoto Action = acGoto
AutoSize = True AutoSize = True
end end
object tbExport: TToolButton
Left = 95
Top = 2
Action = acExport
AutoSize = True
end
object N1: TToolButton object N1: TToolButton
Left = 142 Left = 95
Height = 46 Height = 46
Top = 2 Top = 2
Caption = 'N1' Caption = 'N1'
Style = tbsDivider Style = tbsDivider
end end
object tbHelp: TToolButton object tbRefresh: TToolButton
Left = 501 Left = 100
Top = 2 Top = 2
Action = acHelp Action = acRefresh
AutoSize = True
end
object tbExport: TToolButton
Left = 155
Top = 2
Action = acExport
AutoSize = True
end
object N2: TToolButton
Left = 203
Height = 46
Top = 2
Caption = 'N2'
Style = tbsDivider
end end
object pnlShowWhat: TPanel object pnlShowWhat: TPanel
Left = 147 Left = 208
Height = 46 Height = 46
Top = 2 Top = 2
Width = 115 Width = 115
@ -122,7 +131,7 @@ object IDETodoWindow: TIDETodoWindow
TabOrder = 0 TabOrder = 0
object lblShowWhat: TLabel object lblShowWhat: TLabel
Left = 4 Left = 4
Height = 15 Height = 18
Top = 0 Top = 0
Width = 107 Width = 107
Align = alTop Align = alTop
@ -134,14 +143,14 @@ object IDETodoWindow: TIDETodoWindow
object cboShowWhat: TComboBox object cboShowWhat: TComboBox
AnchorSideBottom.Control = pnlShowWhat AnchorSideBottom.Control = pnlShowWhat
Left = 6 Left = 6
Height = 23 Height = 24
Top = 17 Top = 20
Width = 103 Width = 103
Align = alClient Align = alClient
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Right = 4 BorderSpacing.Right = 4
BorderSpacing.Around = 2 BorderSpacing.Around = 2
ItemHeight = 15 ItemHeight = 24
ItemIndex = 0 ItemIndex = 0
Items.Strings = ( Items.Strings = (
'All' 'All'
@ -152,42 +161,35 @@ object IDETodoWindow: TIDETodoWindow
'ToDo and Notes' 'ToDo and Notes'
'Done and Notes' 'Done and Notes'
) )
OnChange = DoUpdateToDos
TabOrder = 0 TabOrder = 0
Text = 'All' Text = 'All'
OnChange = acRefreshExecute
end end
end end
object N3: TToolButton object N3: TToolButton
Left = 496 Left = 323
Height = 46 Height = 46
Top = 2 Top = 2
Caption = 'N3' Caption = 'N3'
Style = tbsDivider Style = tbsDivider
end end
object N2: TToolButton
Left = 262
Height = 46
Top = 2
Caption = 'N2'
Style = tbsDivider
end
object pnlOptions: TPanel object pnlOptions: TPanel
Left = 267 Left = 328
Height = 36 Height = 42
Top = 2 Top = 2
Width = 229 Width = 281
AutoSize = True AutoSize = True
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 36 ClientHeight = 42
ClientWidth = 229 ClientWidth = 281
TabOrder = 1 TabOrder = 1
object lblOptions: TLabel object lblOptions: TLabel
AnchorSideLeft.Control = pnlOptions AnchorSideLeft.Control = pnlOptions
AnchorSideTop.Control = pnlOptions AnchorSideTop.Control = pnlOptions
Left = 4 Left = 4
Height = 15 Height = 18
Top = 0 Top = 0
Width = 42 Width = 49
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
Caption = 'Options' Caption = 'Options'
@ -198,73 +200,89 @@ object IDETodoWindow: TIDETodoWindow
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 4 Left = 4
Height = 19 Height = 22
Top = 17 Top = 20
Width = 49 Width = 61
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Right = 4 BorderSpacing.Right = 4
Caption = '&Listed' Caption = '&Listed'
Checked = True Checked = True
OnChange = DoUpdateToDos
State = cbChecked State = cbChecked
TabOrder = 0 TabOrder = 0
OnChange = acRefreshExecute
end end
object chkUsed: TCheckBox object chkUsed: TCheckBox
AnchorSideLeft.Control = chkListed AnchorSideLeft.Control = chkListed
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = chkListed AnchorSideTop.Control = chkListed
Left = 57 Left = 69
Height = 19 Height = 22
Top = 17 Top = 20
Width = 44 Width = 56
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Right = 4 BorderSpacing.Right = 4
Caption = '&Used' Caption = '&Used'
Checked = True Checked = True
OnChange = DoUpdateToDos
State = cbChecked State = cbChecked
TabOrder = 1 TabOrder = 1
OnChange = acRefreshExecute
end end
object chkSourceEditor: TCheckBox object chkSourceEditor: TCheckBox
AnchorSideLeft.Control = chkUsed AnchorSideLeft.Control = chkUsed
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = chkListed AnchorSideTop.Control = chkListed
Left = 105 Left = 129
Height = 19 Height = 22
Top = 17 Top = 20
Width = 49 Width = 62
BorderSpacing.Right = 4 BorderSpacing.Right = 4
Caption = 'Editor' Caption = 'Editor'
Checked = True Checked = True
OnChange = DoUpdateToDos
State = cbChecked State = cbChecked
TabOrder = 2 TabOrder = 2
OnChange = acRefreshExecute
end end
object chkPackages: TCheckBox object chkPackages: TCheckBox
AnchorSideLeft.Control = chkSourceEditor AnchorSideLeft.Control = chkSourceEditor
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = chkListed AnchorSideTop.Control = chkListed
Left = 158 Left = 195
Height = 19 Height = 22
Top = 17 Top = 20
Width = 67 Width = 82
BorderSpacing.Right = 4 BorderSpacing.Right = 4
Caption = '&Packages' Caption = '&Packages'
OnChange = DoUpdateToDos
TabOrder = 3 TabOrder = 3
OnChange = acRefreshExecute
end end
end end
object N4: TToolButton
Left = 609
Height = 46
Top = 2
Caption = 'N4'
Style = tbsDivider
end
object tbHelp: TToolButton
Left = 614
Top = 2
Action = acHelp
end
end end
object ActionList: TActionList object ActionList: TActionList
Left = 584 Left = 584
Top = 152 Top = 152
object acEdit: TAction
Caption = 'Edit'
OnExecute = acEditExecute
end
object acGoto: TAction object acGoto: TAction
Caption = 'Goto' Caption = 'Goto'
OnExecute = acGotoExecute OnExecute = acGotoExecute
end end
object acRefresh: TAction object acRefresh: TAction
Caption = 'Refresh' Caption = 'Refresh'
OnExecute = DoUpdateToDos OnExecute = acRefreshExecute
end end
object acExport: TAction object acExport: TAction
Caption = 'Export' Caption = 'Export'

84
components/todolist/todolist.pas
View File

@ -31,6 +31,7 @@
Alexander du Plessis Alexander du Plessis
Silvio Clecio Silvio Clecio
Kevin Jesshope Kevin Jesshope
Juha Manninen
Abstract: Abstract:
List all to do comments of current project and the file List all to do comments of current project and the file
@ -70,7 +71,7 @@ uses
// Codetools // Codetools
CodeToolManager, FileProcs, CodeToolManager, FileProcs,
// IDEIntf // IDEIntf
LazIDEIntf, IDEImagesIntf, PackageIntf, ProjectIntf, LazIDEIntf, IDEImagesIntf, PackageIntf, ProjectIntf, SrcEditorIntf, IDECommands,
// ToDoList // ToDoList
ToDoListCore, ToDoListStrConsts; ToDoListCore, ToDoListStrConsts;
@ -78,12 +79,12 @@ Const
ToDoWindowName = 'IDETodoWindow'; ToDoWindowName = 'IDETodoWindow';
type type
TOnOpenFile = procedure(Sender: TObject; const Filename: string; TOnEditToDo = procedure(aTodoItem: TTodoItem);
const LineNumber: integer) of object;
{ TIDETodoWindow } { TIDETodoWindow }
TIDETodoWindow = class(TForm) TIDETodoWindow = class(TForm)
acEdit: TAction;
acGoto: TAction; acGoto: TAction;
acRefresh: TAction; acRefresh: TAction;
acExport: TAction; acExport: TAction;
@ -97,25 +98,28 @@ type
lblOptions: TLabel; lblOptions: TLabel;
lblShowWhat: TLabel; lblShowWhat: TLabel;
lvTodo: TListView; lvTodo: TListView;
N1: TToolButton;
pnlOptions: TPanel; pnlOptions: TPanel;
pnlShowWhat: TPanel; pnlShowWhat: TPanel;
SaveDialog: TSaveDialog; SaveDialog: TSaveDialog;
tbEdit: TToolButton;
ToolBar: TToolBar; ToolBar: TToolBar;
tbGoto: TToolButton; tbGoto: TToolButton;
tbRefresh: TToolButton; tbRefresh: TToolButton;
tbExport: TToolButton; tbExport: TToolButton;
N1: TToolButton;
N2: TToolButton; N2: TToolButton;
N3: TToolButton; N3: TToolButton;
N4: TToolButton;
tbHelp: TToolButton; tbHelp: TToolButton;
XMLPropStorage: TXMLPropStorage; XMLPropStorage: TXMLPropStorage;
procedure acEditExecute(Sender: TObject);
procedure acExportExecute(Sender: TObject); procedure acExportExecute(Sender: TObject);
procedure acGotoExecute(Sender: TObject); procedure acGotoExecute(Sender: TObject);
procedure acRefreshExecute(Sender: TObject);
procedure acHelpExecute(Sender: TObject); procedure acHelpExecute(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var {%H-}CanClose: boolean); procedure FormCloseQuery(Sender: TObject; var {%H-}CanClose: boolean);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; {%H-}Shift:TShiftState); procedure FormKeyDown(Sender: TObject; var Key: Word; {%H-}Shift:TShiftState);
procedure DoUpdateToDos(Sender: TObject);
procedure lvTodoClick(Sender: TObject); procedure lvTodoClick(Sender: TObject);
procedure lvTodoCompare(Sender : TObject; Item1, Item2 : TListItem; procedure lvTodoCompare(Sender : TObject; Item1, Item2 : TListItem;
{%H-}Data : Integer; var Compare : Integer); {%H-}Data : Integer; var Compare : Integer);
@ -130,9 +134,10 @@ type
FLoadingOptions: boolean; FLoadingOptions: boolean;
FStartFilename: String; FStartFilename: String;
FOwnerProjPack: TObject; // Project or package owning the FStartFilename. FOwnerProjPack: TObject; // Project or package owning the FStartFilename.
FOnOpenFile : TOnOpenFile;
FScannedFiles: TAvlTree;// tree of TTLScannedFile FScannedFiles: TAvlTree;// tree of TTLScannedFile
FScannedIncFiles: TStringMap; FScannedIncFiles: TStringMap;
FOnEditItem: TOnEditToDo;
procedure GotoTodo(aTodoItem: TTodoItem);
procedure SetIDEItem(AValue: string); procedure SetIDEItem(AValue: string);
procedure SetIdleConnected(const AValue: boolean); procedure SetIdleConnected(const AValue: boolean);
function ProjectOpened(Sender: TObject; AProject: TLazProject): TModalResult; function ProjectOpened(Sender: TObject; AProject: TLazProject): TModalResult;
@ -149,8 +154,9 @@ type
property IDEItem: string read FIDEItem write SetIDEItem; // package name or empty for active project property IDEItem: string read FIDEItem write SetIDEItem; // package name or empty for active project
property BaseDirectory: string read FBaseDirectory; property BaseDirectory: string read FBaseDirectory;
property OnOpenFile: TOnOpenFile read FOnOpenFile write FOnOpenFile;
property IdleConnected: boolean read FIdleConnected write SetIdleConnected; property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
property OnEditItem: TOnEditToDo read FOnEditItem write FOnEditItem;
end; end;
var var
@ -171,6 +177,7 @@ begin
if Name<>ToDoWindowName then if Name<>ToDoWindowName then
RaiseGDBException(''); RaiseGDBException('');
ToolBar.Images := IDEImages.Images_16; ToolBar.Images := IDEImages.Images_16;
acEdit.ImageIndex := IDEImages.LoadImage('laz_edit');
acGoto.ImageIndex := IDEImages.LoadImage('menu_goto_line'); acGoto.ImageIndex := IDEImages.LoadImage('menu_goto_line');
acRefresh.ImageIndex := IDEImages.LoadImage('laz_refresh'); acRefresh.ImageIndex := IDEImages.LoadImage('laz_refresh');
acExport.ImageIndex := IDEImages.LoadImage('menu_saveas'); acExport.ImageIndex := IDEImages.LoadImage('menu_saveas');
@ -270,11 +277,6 @@ begin
ModalResult:=mrCancel; ModalResult:=mrCancel;
end; end;
procedure TIDETodoWindow.DoUpdateToDos(Sender: TObject);
begin
UpdateTodos;
end;
procedure TIDETodoWindow.lvTodoClick(Sender: TObject); procedure TIDETodoWindow.lvTodoClick(Sender: TObject);
begin begin
acGoto.Execute; acGoto.Execute;
@ -314,7 +316,8 @@ begin
if TryStrToInt(Item1.SubItems.Strings[lvTodo.SortColumn-1], Int1) if TryStrToInt(Item1.SubItems.Strings[lvTodo.SortColumn-1], Int1)
and TryStrToInt(Item2.SubItems.Strings[lvTodo.SortColumn-1], Int2) then and TryStrToInt(Item2.SubItems.Strings[lvTodo.SortColumn-1], Int2) then
Compare := CompareValue(Int1, Int2) Compare := CompareValue(Int1, Int2)
else Compare := 0; else
Compare := 0;
end; end;
else Compare := 0; else Compare := 0;
end; end;
@ -457,26 +460,42 @@ begin
XMLPropStorage.Active := True; XMLPropStorage.Active := True;
end; end;
procedure TIDETodoWindow.GotoTodo(aTodoItem: TTodoItem);
begin
LazarusIDE.DoOpenFileAndJumpToPos(aTodoItem.Filename, aTodoItem.CodePos,-1,-1,-1,
[ofOnlyIfExists,ofRegularFile,ofVirtualFile,ofDoNotLoadResource]);
end;
procedure TIDETodoWindow.acEditExecute(Sender: TObject);
var
ListItem: TListItem;
TodoItem: TTodoItem;
SrcEdit: TSourceEditorInterface;
begin
Assert(Assigned(OnEditItem), 'TIDETodoWindow.acEditExecute: OnEditItem=Nil');
ListItem := lvtodo.Selected;
if (ListItem=nil) or (ListItem.Data=nil) then exit;
TodoItem := TTodoItem(ListItem.Data);
SrcEdit := SourceEditorManagerIntf.ActiveEditor;
if (SrcEdit=nil) or SrcEdit.ReadOnly then exit;
debugln(['TIDETodoWindow.acEditExecute ToDo=', TodoItem.Filename, ', Src=', SrcEdit.FileName]);
if (TodoItem.Filename<>SrcEdit.FileName) or (TodoItem.CodePos<>SrcEdit.CursorTextXY) then
GotoTodo(TodoItem); // Move to the right place if not there already.
OnEditItem(TodoItem); // Open the dialog for editing.
end;
procedure TIDETodoWindow.acGotoExecute(Sender: TObject); procedure TIDETodoWindow.acGotoExecute(Sender: TObject);
var var
CurFilename: String; ListItem: TListItem;
aTodoItem: TTodoItem;
aListItem: TListItem;
TheLine: integer;
begin begin
CurFilename:=''; ListItem := lvtodo.Selected;
aListItem:= lvtodo.Selected; if Assigned(ListItem) and Assigned(ListItem.Data) then
if Assigned(aListItem) and Assigned(aListItem.Data) then GotoTodo(TTodoItem(ListItem.Data));
begin end;
aTodoItem := TTodoItem(aListItem.Data);
CurFileName := aTodoItem.Filename; procedure TIDETodoWindow.acRefreshExecute(Sender: TObject);
TheLine := aTodoItem.LineNumber; begin
if Assigned(OnOpenFile) then UpdateTodos;
OnOpenFile(Self,CurFilename,TheLine)
else
LazarusIDE.DoOpenFileAndJumpToPos(CurFilename,Point(1,TheLine),-1,-1,-1,
[ofOnlyIfExists,ofRegularFile,ofVirtualFile,ofDoNotLoadResource]);
end;
end; end;
procedure TIDETodoWindow.acHelpExecute(Sender: TObject); procedure TIDETodoWindow.acHelpExecute(Sender: TObject);
@ -499,7 +518,7 @@ end;
procedure TIDETodoWindow.AddListItem(aTodoItem: TTodoItem); procedure TIDETodoWindow.AddListItem(aTodoItem: TTodoItem);
function ShowThisToDoItem:boolean; function ShowThisToDoItem: boolean;
// Add this ToDoItem based on the cboShowWhat selection // Add this ToDoItem based on the cboShowWhat selection
begin begin
case cboShowWhat.ItemIndex of case cboShowWhat.ItemIndex of
@ -514,7 +533,6 @@ procedure TIDETodoWindow.AddListItem(aTodoItem: TTodoItem);
var var
aListItem: TListItem; aListItem: TListItem;
aFilename: String; aFilename: String;
begin begin
if Assigned(aTodoItem) and ShowThisToDoItem then if Assigned(aTodoItem) and ShowThisToDoItem then
begin begin
@ -528,7 +546,7 @@ begin
if (BaseDirectory<>'') and FilenameIsAbsolute(aFilename) then if (BaseDirectory<>'') and FilenameIsAbsolute(aFilename) then
aFilename:=CreateRelativePath(aFilename,BaseDirectory); aFilename:=CreateRelativePath(aFilename,BaseDirectory);
aListitem.SubItems.Add(aFilename); aListitem.SubItems.Add(aFilename);
aListitem.SubItems.Add(IntToStr(aTodoItem.LineNumber)); aListitem.SubItems.Add(IntToStr(aTodoItem.CodePos.Y));
aListitem.SubItems.Add(aTodoItem.Owner); aListitem.SubItems.Add(aTodoItem.Owner);
aListitem.SubItems.Add(aTodoItem.Category); aListitem.SubItems.Add(aTodoItem.Category);
end; end;

85
components/todolist/todolistcore.pas
View File

@ -65,13 +65,16 @@ type
TTodoItem = class(TObject) TTodoItem = class(TObject)
private private
FCategory: string; FCategory: string;
FToDoType: TToDoType;
FTokenStyle: TTokenStyle; FTokenStyle: TTokenStyle;
FFilename: string; FToDoType: TToDoType;
FLineNumber: integer;
FOwner: string;
FPriority: integer; FPriority: integer;
FText: string; FText: string;
FHasColon: Boolean;
FCodePos: TPoint; // Column : line in file.
FCommentLen: integer; // Original length including comment characters.
FCommentType: char; // Characters of comment start / end.
FFilename: string;
FOwner: string;
function GetQuotedCategory: string; function GetQuotedCategory: string;
function GetQuotedOwner: string; function GetQuotedOwner: string;
function GetAsComment: string; function GetAsComment: string;
@ -80,13 +83,16 @@ type
function Parse(const aTokenString: string; aRequireColon: Boolean): Boolean; function Parse(const aTokenString: string; aRequireColon: Boolean): Boolean;
public public
property Category: string read FCategory write FCategory; property Category: string read FCategory write FCategory;
property QuotedCategory:string read GetQuotedCategory; property QuotedCategory: string read GetQuotedCategory;
property TokenStyle: TTokenStyle read FTokenStyle write FTokenStyle; property TokenStyle: TTokenStyle read FTokenStyle write FTokenStyle;
property ToDoType:TToDoType read FToDoType write FToDoType; property ToDoType: TToDoType read FToDoType write FToDoType;
property LineNumber: integer read FLineNumber write FLineNumber; property HasColon: Boolean read FHasColon write FHasColon;
property CodePos: TPoint read FCodePos write FCodePos;
property CommentLen: integer read FCommentLen write FCommentLen;
property CommentType: char read FCommentType write FCommentType;
property Filename: string read FFilename write FFilename; property Filename: string read FFilename write FFilename;
property Owner: string read FOwner write FOwner; property Owner: string read FOwner write FOwner;
property QuotedOwner:string read GetQuotedOwner; property QuotedOwner: string read GetQuotedOwner;
property Priority: integer read FPriority write FPriority; property Priority: integer read FPriority write FPriority;
property Text: string read FText write FText; property Text: string read FText write FText;
property AsString: string read GetAsString; property AsString: string read GetAsString;
@ -107,8 +113,7 @@ type
FScannedIncFiles: TStringMap; FScannedIncFiles: TStringMap;
function GetCount: integer; function GetCount: integer;
function GetItems(Index: integer): TTodoItem; function GetItems(Index: integer): TTodoItem;
procedure CreateToDoItem(const aStartComment, aEndComment: string; procedure CreateToDoItem(aCommentType: char; aCodePos: TPoint);
aLineNumber: Integer);
procedure ScanPascalToDos; procedure ScanPascalToDos;
procedure ScanToDoFile; procedure ScanToDoFile;
public public
@ -162,7 +167,7 @@ begin
s:=LIST_INDICATORS[lToDoItem.ToDoType] + ','; s:=LIST_INDICATORS[lToDoItem.ToDoType] + ',';
t:=DelChars(lToDoItem.Text,',');{Strip any commas that can cause a faulty csv file} t:=DelChars(lToDoItem.Text,',');{Strip any commas that can cause a faulty csv file}
s:=s+t+','+IntToStr(lToDoItem.Priority)+','+lToDoItem.Filename+ s:=s+t+','+IntToStr(lToDoItem.Priority)+','+lToDoItem.Filename+
','+IntToStr(lToDoItem.LineNumber)+','+lToDoItem.Owner+','+lToDoItem.Category; ','+IntToStr(lToDoItem.CodePos.Y)+','+lToDoItem.Owner+','+lToDoItem.Category;
lCommaList.Add(s); lCommaList.Add(s);
Inc(i); Inc(i);
end; end;
@ -235,24 +240,30 @@ begin
Result:=TTodoItem(FItems[Index]); Result:=TTodoItem(FItems[Index]);
end; end;
procedure TTLScannedFile.CreateToDoItem(const aStartComment, aEndComment: string; procedure TTLScannedFile.CreateToDoItem(aCommentType: char; aCodePos: TPoint);
aLineNumber: Integer);
var var
TheToken: string; TheToken: string;
lTokenFound: boolean; lTokenFound: boolean;
lCommentLen, lStartLen, lEndLen: Integer;
lTodoType, lFoundToDoType: TToDoType; lTodoType, lFoundToDoType: TToDoType;
lTokenStyle, lFoundTokenStyle: TTokenStyle; lTokenStyle, lFoundTokenStyle: TTokenStyle;
NewToDoItem: TTodoItem; NewToDoItem: TTodoItem;
begin begin
//DebugLn(['TTLScannedFile.CreateToDoItem FileName=',FRealFilename, //DebugLn(['TTLScannedFile.CreateToDoItem FileName=',FRealFilename,
// ', LineNumber=',aLineNumber, ', FCommentStr=',FCommentStr]); // ', aCodePos=',aCodePos.X,':',aCodePos.Y,', FCommentStr=',FCommentStr]);
lCommentLen := Length(FCommentStr);
// Remove beginning and ending comment characters from the string // Remove beginning and ending comment characters from the string
if aStartComment <> '' then case aCommentType of
Delete(FCommentStr, 1, Length(aStartComment)); #0 : begin lStartLen := 0; lEndLen := 0; end; // A dedicated .todo file
if aEndComment <> '' then begin '/' : begin lStartLen := 2; lEndLen := 0; end; // //
Assert(LazEndsStr(aEndComment, FCommentStr), 'TTLScannedFile.CreateToDoItem: No comment end.'); '{' : begin lStartLen := 1; lEndLen := 1; end; // { }
SetLength(FCommentStr, Length(FCommentStr)-Length(aEndComment)); '(' : begin lStartLen := 2; lEndLen := 2; end; // (* *)
else raise Exception.Create('TTLScannedFile.CreateToDoItem: Wrong comment char.');
end; end;
if lStartLen > 0 then
Delete(FCommentStr, 1, lStartLen);
if lEndLen > 0 then
SetLength(FCommentStr, Length(FCommentStr)-lEndLen);
FCommentStr := TextToSingleLine(FCommentStr); FCommentStr := TextToSingleLine(FCommentStr);
// Determine Token and Style // Determine Token and Style
@ -291,7 +302,9 @@ begin
begin begin
NewToDoItem.ToDoType := lFoundToDoType; NewToDoItem.ToDoType := lFoundToDoType;
NewToDoItem.TokenStyle := lFoundTokenStyle; NewToDoItem.TokenStyle := lFoundTokenStyle;
NewToDoItem.LineNumber := aLineNumber; NewToDoItem.CodePos := aCodePos;
NewToDoItem.CommentLen := lCommentLen;
NewToDoItem.CommentType:= aCommentType;
NewToDoItem.Filename := FRealFilename; NewToDoItem.Filename := FRealFilename;
Add(NewToDoItem); // Add to list. Add(NewToDoItem); // Add to list.
end end
@ -337,7 +350,8 @@ var
Src, LocationIncTodo: String; Src, LocationIncTodo: String;
p, CommentEnd: Integer; p, CommentEnd: Integer;
NestedComment: Boolean; NestedComment: Boolean;
CodePos: TCodeXYPosition; CaretPos: TCodeXYPosition;
CodePos: TPoint;
begin begin
Src:=FTool.Src; Src:=FTool.Src;
Assert(FCode.Filename=FTool.MainFilename, 'TTLScannedFile.ScanPascalToDos: aCode.Filename<>FTool.MainFilename'); Assert(FCode.Filename=FTool.MainFilename, 'TTLScannedFile.ScanPascalToDos: aCode.Filename<>FTool.MainFilename');
@ -347,15 +361,15 @@ begin
p:=FindNextComment(Src,p); p:=FindNextComment(Src,p);
if p>length(Src) then // No more comments found, break loop if p>length(Src) then // No more comments found, break loop
break; break;
if not FTool.CleanPosToCaret(p,CodePos) then if not FTool.CleanPosToCaret(p,CaretPos) then
begin begin
ShowMessageFmt(errScanFileFailed, [ExtractFileName(FFilename)]); ShowMessageFmt(errScanFileFailed, [ExtractFileName(FFilename)]);
Exit; Exit;
end; end;
// Study include file names. Use heuristics, assume name ends with ".inc". // Study include file names. Use heuristics, assume name ends with ".inc".
FRealFilename:=CodePos.Code.Filename; FRealFilename:=CaretPos.Code.Filename;
if FilenameExtIs(FRealFilename, 'inc') then // Filename and location in an include file. if FilenameExtIs(FRealFilename, 'inc') then // Filename and location in an include file.
LocationIncTodo:=FRealFilename+'_'+IntToStr(CodePos.Y) LocationIncTodo:=FRealFilename+'_'+IntToStr(CaretPos.Y)
else else
LocationIncTodo:=''; LocationIncTodo:='';
// Process a comment // Process a comment
@ -364,12 +378,9 @@ begin
// Process each include file location only once. Units are processed always. // Process each include file location only once. Units are processed always.
if (LocationIncTodo='') or not FScannedIncFiles.Contains(LocationIncTodo) then if (LocationIncTodo='') or not FScannedIncFiles.Contains(LocationIncTodo) then
begin begin
if Src[p]='/' then CodePos.X:=CaretPos.X;
CreateToDoItem('//', '', CodePos.Y) CodePos.Y:=CaretPos.Y;
else if Src[p]='{' then CreateToDoItem(Src[p], CodePos);
CreateToDoItem('{', '}', CodePos.Y)
else if Src[p]='(' then
CreateToDoItem('(*', '*)', CodePos.Y);
if LocationIncTodo<>'' then // Store include file location for future. if LocationIncTodo<>'' then // Store include file location for future.
FScannedIncFiles.Add(LocationIncTodo); FScannedIncFiles.Add(LocationIncTodo);
end; end;
@ -380,6 +391,7 @@ end;
procedure TTLScannedFile.ScanToDoFile; procedure TTLScannedFile.ScanToDoFile;
var var
List: TStringList; List: TStringList;
CodePos: TPoint;
i: Integer; i: Integer;
begin begin
List:=TStringList.Create; List:=TStringList.Create;
@ -389,7 +401,9 @@ begin
begin begin
FRealFilename:=FCode.Filename; FRealFilename:=FCode.Filename;
FCommentStr:=List[i]; FCommentStr:=List[i];
CreateToDoItem('', '', i+1) CodePos.X:=1;
CodePos.Y:=i+1;
CreateToDoItem(#0, CodePos)
end; end;
finally finally
List.Free; List.Free;
@ -435,7 +449,13 @@ end;
function TTodoItem.GetAsComment: string; function TTodoItem.GetAsComment: string;
begin begin
Result := '{ '+AsString+' }'; case CommentType of
#0 : Result := AsString; // A dedicated .todo file
'/' : Result := '// '+AsString;
'{' : Result := '{ ' +AsString+' }';
'(' : Result := '(* '+AsString+' *)';
else raise Exception.Create('TTodoItem.GetAsComment: Wrong comment char.');
end;
end; end;
type type
@ -452,7 +472,6 @@ function TTodoItem.Parse(const aTokenString: string; aRequireColon: Boolean): Bo
var var
lParseState: TParseState; lParseState: TParseState;
i, lPriorityStart: Integer; i, lPriorityStart: Integer;
HasColon: Boolean;
lTempStr, lStr: string; lTempStr, lStr: string;
lpTemp: PChar; lpTemp: PChar;
begin begin

1
components/todolist/todoliststrconsts.pas
View File

@ -53,6 +53,7 @@ resourcestring
lisSourceEditorHint = 'Add units in source editor'; lisSourceEditorHint = 'Add units in source editor';
dlgUnitDepRefresh = 'Refresh'; dlgUnitDepRefresh = 'Refresh';
lisTDDInsertToDo = 'Insert a ToDo/Done/Note'; lisTDDInsertToDo = 'Insert a ToDo/Done/Note';
lisTDDEditToDo = 'Edit the ToDo/Done/Note';
lisViewToDoList = 'View ToDo List'; lisViewToDoList = 'View ToDo List';
lisToDoList = 'ToDo List'; lisToDoList = 'ToDo List';
lisPkgFileTypeText = 'Text'; lisPkgFileTypeText = 'Text';