1 (***************************************************************************
2 todolist.pp
3 --------------------
4
5 ***************************************************************************/
6
7 ***************************************************************************
8 * *
9 * This source is free software; you can redistribute it and/or modify *
10 * it under the terms of the GNU General Public License as published by *
11 * the Free Software Foundation; either version 2 of the License, or *
12 * (at your option) any later version. *
13 * *
14 * This code is distributed in the hope that it will be useful, but *
15 * WITHOUT ANY WARRANTY; without even the implied warranty of *
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
17 * General Public License for more details. *
18 * *
19 * A copy of the GNU General Public License is available on the World *
20 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
21 * obtain it by writing to the Free Software Foundation, *
22 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
23 * *
24 ***************************************************************************
25
26
27 Author:
28 Olivier GUILBAUD <golivier@free.fr>,
29 Gerard Visent <gerardusmercator@gmail.com>
30 Mattias Gaertner
31 Alexander du Plessis
32 Silvio Clecio
33
34 Abstract:
35 List all to do comments of current project and the file
36 projectname.todo.
37 {TODO -oOwnerName -cCategoryName: Todo_text}
38 {DONE -oOwnerName -cCategoryName: Todo_text}
39 {#todo -oOwnerName -cCategoryName: Todo_text}
40 {#done -oOwnerName -cCategoryName: Todo_text}
41
42 the -o and -c tags are optional.
43
44 If the -o and -c tags are not used, then the variant without semicolon is
45 allowed too:
46 {TODO Todo_text}
47 {DONE Todo_text}
48 {#todo Todo_text}
49 {#done Todo_text}
50
51
52 Sub comments in nested comments are ignored.
53 *)
54
55 unit TodoList;
56
57 {$mode objfpc}{$H+}
58
59 interface
60
61 uses
62 // FCL, RTL
63 Classes, SysUtils, Math, StrUtils, Laz_AVL_Tree,
64 // LCL
65 LCLProc, LCLType, LclIntf, Forms, Controls, StdCtrls, Dialogs, ComCtrls,
66 ActnList, XMLPropStorage,
67 // LazUtils
68 LazUTF8Classes, LazFileUtils, LazFileCache, LazLoggerBase,
69 // Codetools
70 CodeCache, CodeToolManager, BasicCodeTools, FileProcs,
71 // IDEIntf
72 LazIDEIntf, IDEImagesIntf, PackageIntf, ProjectIntf, PackageDependencyIntf,
73 // ToDoList
74 ToDoListStrConsts;
75
76
77 Const
78 cTodoFlag = '#todo';
79 cDoneFlag = '#done';
80 cAltTodoFLag = 'todo';
81 cAltDoneFLag = 'done';
82 ToDoWindowName = 'IDETodoWindow';
83
84 type
85 TOnOpenFile = procedure(Sender: TObject; const Filename: string;
86 const LineNumber: integer) of object;
87 TTLScannedFile = class;
88
89 { TTodoItem: Class to hold TODO item information }
90
91 TTodoItem = class(TObject)
92 private
93 FAltNotation: boolean;
94 FCategory: string;
95 FDone: boolean;
96 FFilename: string;
97 FLineNumber: integer;
98 FOwner: string;
99 FPriority: integer;
100 FText: string;
101 FTLFile: TTLScannedFile;
GetAsCommentnull102 function GetAsComment: string;
GetAsStringnull103 function GetAsString: string;
104 public
105 constructor Create(aTLFile: TTLScannedFile);
106 property TLFile: TTLScannedFile read FTLFile;
107 property AltNotation: boolean read FAltNotation write FAltNotation;
108 property Category: string read FCategory write FCategory;
109 property Done: boolean read FDone write FDone;
110 property LineNumber: integer read FLineNumber write FLineNumber;
111 property Filename: string read FFilename write FFilename;
112 property Owner: string read FOwner write FOwner;
113 property Priority: integer read FPriority write FPriority;
114 property Text: string read FText write FText;
115 property AsString: string read GetAsString;
116 property AsComment: string read GetAsComment;
117 end;
118
119 { TTLScannedFiles }
120
121 TTLScannedFile = class
122 fItems: TFPList;// list of TTodoItem
123 private
GetCountnull124 function GetCount: integer;
GetItemsnull125 function GetItems(Index: integer): TTodoItem;
126 public
127 Filename: string; // = Tool.MainFilename
128 CodeChangeStep: integer; // = Tool.Scanner.ChangeStep
129 constructor Create;
130 destructor Destroy; override;
131 procedure Clear;
132 procedure Add(Item: TTodoItem);
133 property Count: integer read GetCount;
134 property Items[Index: integer]: TTodoItem read GetItems; default;
135 end;
136
137 { TIDETodoWindow }
138
139 TIDETodoWindow = class(TForm)
140 acGoto: TAction;
141 acRefresh: TAction;
142 acExport: TAction;
143 acHelp: TAction;
144 ActionList: TActionList;
145 chkListed: TCheckBox;
146 chkUsed: TCheckBox;
147 chkPackages: TCheckBox;
148 chkSourceEditor: TCheckBox;
149 grbOptions: TGroupBox;
150 lvTodo: TListView;
151 SaveDialog: TSaveDialog;
152 ToolBar: TToolBar;
153 tbGoto: TToolButton;
154 tbRefresh: TToolButton;
155 tbExport: TToolButton;
156 N1: TToolButton;
157 tbHelp: TToolButton;
158 XMLPropStorage: TXMLPropStorage;
159 procedure acExportExecute(Sender: TObject);
160 procedure acGotoExecute(Sender: TObject);
161 procedure acHelpExecute(Sender: TObject);
162 procedure acRefreshExecute(Sender: TObject);
163 procedure chkListedChange(Sender: TObject);
164 procedure chkPackagesChange(Sender: TObject);
165 procedure chkSourceEditorChange(Sender: TObject);
166 procedure chkUsedChange(Sender: TObject);
167 procedure FormCloseQuery(Sender: TObject; var {%H-}CanClose: boolean);
168 procedure FormCreate(Sender: TObject);
169 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift:TShiftState);
170 procedure FormShow(Sender: TObject);
171 procedure lvTodoClick(Sender: TObject);
172 procedure lvTodoColumnClick(Sender : TObject; Column : TListColumn);
173 procedure lvTodoCompare(Sender : TObject; Item1, Item2 : TListItem;
174 {%H-}Data : Integer; var Compare : Integer);
175 procedure SaveDialogShow(Sender: TObject);
176 procedure XMLPropStorageRestoreProperties(Sender: TObject);
177 procedure XMLPropStorageRestoringProperties(Sender: TObject);
178 private
179 FBaseDirectory: string;
180 fUpdating, fUpdateNeeded: Boolean;
181 FIDEItem: string;
182 FIdleConnected: boolean;
183 FLoadingOptions: boolean;
184 fStartFilename: String;
185 FOnOpenFile : TOnOpenFile;
186 fScannedFiles: TAvlTree;// tree of TTLScannedFile
187
188 procedure SetIDEItem(AValue: string);
189 procedure SetIdleConnected(const AValue: boolean);
190 procedure SetStartFilename(const AValue: String);
191 procedure UpdateStartFilename;
192 procedure ResolveIDEItem(out CurOwner: TObject; out CurProject: TLazProject;
193 out CurPkg: TIDEPackage);
194
195 procedure CreateToDoItem(aTLFile: TTLScannedFile;
196 const aFileName: string; const SComment, EComment: string;
197 const TokenString: string; LineNumber: Integer);
198 procedure AddListItem(aTodoItem: TTodoItem);
199
200 procedure ScanFile(aFileName : string);
201 procedure OnIdle(Sender: TObject; var Done: Boolean);
202 public
203 constructor Create(AOwner: TComponent); override;
204 destructor Destroy; override;
205
206 procedure UpdateTodos(Immediately: boolean = false);
207
208 property IDEItem: string read FIDEItem write SetIDEItem; // package name or empty for active project
209 property StartFilename: String read fStartFilename write SetStartFilename; // lpi, lpk or a source file
210 property BaseDirectory: string read FBaseDirectory;
211 property OnOpenFile: TOnOpenFile read FOnOpenFile write FOnOpenFile;
212 property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
213 end;
214
215 var
216 IDETodoWindow: TIDETodoWindow;
217
218 implementation
219
220 {$R *.lfm}
221
222 const
223 DefaultTodoListCfgFile = 'todolistoptions.xml';
224
CompareTLScannedFilesnull225 function CompareTLScannedFiles(Data1, Data2: Pointer): integer;
226 begin
227 Result:=CompareFilenames(TTLScannedFile(Data1).Filename,
228 TTLScannedFile(Data2).Filename);
229 end;
230
CompareAnsiStringWithTLScannedFilenull231 function CompareAnsiStringWithTLScannedFile(Filename, ScannedFile: Pointer): integer;
232 begin
233 Result:=CompareFilenames(AnsiString(Filename),
234 TTLScannedFile(ScannedFile).Filename);
235 end;
236
237 { TIDETodoWindow }
238
239 constructor TIDETodoWindow.Create(AOwner: TComponent);
240 begin
241 inherited Create(AOwner);
242 if Name<>ToDoWindowName then RaiseGDBException('');
243 ToolBar.Images := IDEImages.Images_16;
244 acGoto.ImageIndex := IDEImages.LoadImage('menu_goto_line');
245 acRefresh.ImageIndex := IDEImages.LoadImage('laz_refresh');
246 acExport.ImageIndex := IDEImages.LoadImage('menu_saveas');
247 acHelp.ImageIndex := IDEImages.LoadImage('btn_help');
248
249 SaveDialog.Filter:= dlgFilterCsv+'|*.csv';
250 end;
251
252 destructor TIDETodoWindow.Destroy;
253 begin
254 fScannedFiles.FreeAndClear;
255 FreeAndNil(fScannedFiles);
256 inherited Destroy;
257 end;
258
259 procedure TIDETodoWindow.UpdateTodos(Immediately: boolean);
260 var
261 i: integer;
262 St : String;
263 CurOwner: TObject;
264 Node: TAvlTreeNode;
265 CurFile: TTLScannedFile;
266 Units: TStrings;
267 CurProject: TLazProject;
268 CurPkg: TIDEPackage;
269 Flags: TFindUnitsOfOwnerFlags;
270 begin
271 if FLoadingOptions then
272 exit;
273 if not Immediately then begin
274 fUpdateNeeded:=true;
275 IdleConnected:=true;
276 exit;
277 end;
278 fUpdateNeeded:=false;
279 if fUpdating then Exit;
280 LazarusIDE.SaveSourceEditorChangesToCodeCache(nil);
281
282 Screen.Cursor:=crHourGlass;
283 lvTodo.BeginUpdate;
284 Units:=nil;
285 try
286 fUpdating:=True;
287 CodeToolBoss.ActivateWriteLock;
288
289 fScannedFiles.FreeAndClear;
290 lvTodo.Items.Clear;
291
292 if StartFilename<>'' then begin
293 // Find a '.todo' file of the main source
294 St:=ChangeFileExt(StartFilename,'.todo');
295 if FileExistsCached(St) then
296 ScanFile(St);
297 // Scan main source file
298 if FilenameIsPascalUnit(StartFilename) then
299 ScanFile(StartFilename);
300 end;
301
302 ResolveIDEItem(CurOwner,CurProject,CurPkg);
303 if CurOwner=nil then Exit;
304
305 Flags:=[];
306 if chkListed.Checked then
307 Include(Flags, fuooListed);
308 if chkUsed.Checked then
309 Include(Flags, fuooUsed);
310 if chkPackages.Checked then
311 Include(Flags, fuooPackages);
312 if chkSourceEditor.Checked then
313 Include(Flags, fuooSourceEditor);
314
315 Units:=LazarusIDE.FindUnitsOfOwner(CurOwner,Flags);
316 for i:=0 to Units.Count-1 do
317 ScanFile(Units[i]);
318
319 Node:=fScannedFiles.FindLowest;
320 while Node<>nil do begin
321 CurFile:=TTLScannedFile(Node.Data);
322 for i:=0 to CurFile.Count-1 do
323 AddListItem(CurFile[i]);
324 Node:=fScannedFiles.FindSuccessor(Node);
325 end;
326 finally
327 Units.Free;
328 CodeToolBoss.DeactivateWriteLock;
329 lvTodo.EndUpdate;
330 Screen.Cursor:=crDefault;
331 fUpdating:=False;
332 end;
333 end;
334
335 procedure TIDETodoWindow.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
336 begin
337 if Shift=[] then ;
338 if (Key=VK_ESCAPE) then
339 ModalResult:=mrCancel;
340 end;
341
342 procedure TIDETodoWindow.FormShow(Sender: TObject);
343 begin
344 UpdateTodos;
345 end;
346
347 procedure TIDETodoWindow.lvTodoClick(Sender: TObject);
348 begin
349 acGoto.Execute;
350 end;
351
352 procedure TIDETodoWindow.lvTodoColumnClick(Sender : TObject; Column : TListColumn);
353 Var
354 aListItem : TListItem;
355 begin
356 aListItem := lvTodo.Selected;
357
358 If lvTodo.SortDirection = sdAscending then
359 lvTodo.SortDirection := sdDescending
360 Else
361 lvTodo.SortDirection := sdAscending;
362
363 lvTodo.SortColumn := Column.Index;
364
365 lvTodo.Selected := nil; // Otherwise wrong selection - bug??
366 lvTodo.Selected := aListItem;
367
368 lvTodo.Update; // First row not redrawn?
369 //lvTodo.Repaint;
370 end;
371
372 procedure TIDETodoWindow.lvTodoCompare(Sender : TObject;
373 Item1, Item2 : TListItem; Data : Integer; var Compare : Integer);
374 var
375 Str1: String;
376 Str2: String;
377 Int1: Integer;
378 Int2: Integer;
379 begin
380 Case lvTodo.SortColumn of
381 0, 1, 3, 5, 6 :
382 begin
383 if lvTodo.SortColumn = 0 then
384 begin
385 Str1 := TListItem(Item1).Caption;
386 Str2 := TListItem(Item2).Caption;
387 end else
388 begin
389 // Checks against Subitems.Count necessary??
390
391 if lvTodo.SortColumn <= Item1.SubItems.Count then
392 Str1 := Item1.SubItems.Strings[lvTodo.SortColumn-1]
393 else Str1 := '';
394
395 if lvTodo.SortColumn <= Item2.SubItems.Count then
396 Str2 := Item2.SubItems.Strings[lvTodo.SortColumn-1]
397 else Str2 := '';
398 end;
399 Compare := AnsiCompareText(Str1, Str2);
400 end;
401 2, 4 :
402 begin
403 if TryStrToInt(Item1.SubItems.Strings[lvTodo.SortColumn-1], Int1)
404 and TryStrToInt(Item2.SubItems.Strings[lvTodo.SortColumn-1], Int2) then
405 Compare := CompareValue(Int1, Int2)
406 else Compare := 0;
407 end;
408 else Compare := 0;
409 end;
410
411 if lvTodo.SortDirection = sdDescending then Compare := -Compare;
412 end;
413
414 procedure TIDETodoWindow.SaveDialogShow(Sender: TObject);
415 begin
416 SaveDialog.InitialDir:=GetCurrentDirUTF8;
417 end;
418
419 procedure TIDETodoWindow.XMLPropStorageRestoreProperties(Sender: TObject);
420 begin
421 FLoadingOptions := False;
422 UpdateTodos;
423 end;
424
425 procedure TIDETodoWindow.XMLPropStorageRestoringProperties(Sender: TObject);
426 begin
427 FLoadingOptions := True;
428 end;
429
430 //Initialise the todo project and find them
431 procedure TIDETodoWindow.SetStartFilename(const AValue: String);
432 begin
433 //debugln(['TIDETodoWindow.SetOwnerFilename ',AValue]);
434 if fStartFilename=AValue then exit;
435 fStartFilename:=AValue;
436 UpdateTodos;
437 end;
438
439 procedure TIDETodoWindow.UpdateStartFilename;
440 var
441 NewStartFilename: String;
442 CurObject: TObject;
443 CurProject: TLazProject;
444 CurPkg: TIDEPackage;
445 begin
446 ResolveIDEItem(CurObject,CurProject,CurPkg);
447 NewStartFilename:='';
448 if CurPkg<>nil then begin
449 // package
450 NewStartFilename:=CurPkg.Filename;
451 end else if CurProject<>nil then begin
452 // project
453 NewStartFilename:=CurProject.ProjectInfoFile;
454 end;
455 StartFilename:=NewStartFilename;
456 end;
457
458 procedure TIDETodoWindow.ResolveIDEItem(out CurOwner: TObject;
459 out CurProject: TLazProject; out CurPkg: TIDEPackage);
460 begin
461 CurOwner:=nil;
462 CurProject:=nil;
463 CurPkg:=nil;
464 if LazIsValidIdent(IDEItem,true) then begin
465 // package
466 CurPkg:=PackageEditingInterface.FindPackageWithName(IDEItem);
467 CurOwner:=CurPkg;
468 end else begin
469 // project
470 CurProject:=LazarusIDE.ActiveProject;
471 CurOwner:=CurProject;
472 end;
473 end;
474
475 procedure TIDETodoWindow.SetIdleConnected(const AValue: boolean);
476 begin
477 if FIdleConnected=AValue then exit;
478 FIdleConnected:=AValue;
479 if IdleConnected then
480 Application.AddOnIdleHandler(@OnIdle)
481 else
482 Application.RemoveOnIdleHandler(@OnIdle);
483 end;
484
485 procedure TIDETodoWindow.SetIDEItem(AValue: string);
486 begin
487 if FIDEItem=AValue then exit;
488 FIDEItem:=AValue;
489 UpdateStartFilename;
490 end;
491
492 procedure TIDETodoWindow.CreateToDoItem(aTLFile: TTLScannedFile;
493 const aFileName: string; const SComment, EComment: string;
494 const TokenString: string; LineNumber: Integer);
495 var
496 N, Strlen: Integer;
497 TempStr, ParsingString, LowerString : string;
498 IsAltNotation, IsDone, HasSemiColon: boolean;
499 aChar: char;
500 TodoItem: TTodoItem;
501
502 const
503 cSemiColon = ':';
504 cWhiteSpace = ' ';
505
506 Procedure SetItemFields(aItem: TTodoItem; aStr: String);
507 var
508 aPriority: integer;
509 begin
510 if aStr <> '' then
511 begin
512 // Category
513 if pos('-c', aStr) = 1 then
514 aItem.Category := Copy(aStr, 3, Length(aStr)-2)
515 else
516 begin
517 // Owner
518 if pos('-o', aStr) = 1 then
519 aItem.Owner := Copy(aStr, 3, Length(aStr)-2)
520 else
521 begin
522 // Priority
523 if TryStrToInt(aStr, aPriority) then
524 aItem.Priority := aPriority;
525 end;
526 end;
527 end;
528 end;
529
530 begin
531 //DebugLn(['TfrmTodo.CreateToDoItem aFileName=',aFileName,' LineNumber=',LineNumber]);
532 TodoItem := nil;
533 ParsingString:= TextToSingleLine(TokenString);
534 // Remove the beginning comment chars from input string
535 Delete(ParsingString, 1, Length(SComment));
536 // Remove leading and trailing blanks from input
537 ParsingString := Trim(ParsingString);
538 // See if it's a TODO or DONE item
539 LowerString := lowercase(ParsingString);
540 if (Pos(cTodoFlag, LowerString) = 1) then
541 begin
542 IsDone := False;
543 IsAltNotation := False;
544 end
545 else
546 begin
547 if (Pos(cAltTodoFLag, LowerString) = 1) then
548 begin
549 IsDone := False;
550 IsAltNotation := True;
551 end
552 else
553 begin
554 if (Pos(cDoneFlag, LowerString) = 1) then
555 begin
556 IsDone := True;
557 IsAltNotation := False;
558 end
559 else
560 begin
561 if (Pos(cAltDoneFLag, LowerString) = 1) then
562 begin
563 IsDone := True;
564 IsAltNotation := True;
565 end
566 else
567 // Not a Todo/Done item, leave
568 Exit;
569 end;
570 end;
571 end;
572
573 // Remove the ending comment chars from input string
574 if (EComment <> '')
575 and (RightStr(ParsingString, Length(EComment)) = EComment) then
576 ParsingString := TextToSingleLine(Copy(ParsingString, 1, Length(ParsingString)-Length(EComment)));
577
578 // Remove Todo/Done flag from input string
579 if isAltNotation then
580 Delete(ParsingString, 1, 4)
581 else
582 Delete(ParsingString, 1, 5);
583
584 HasSemiColon := Pos(cSemiColon, ParsingString)>0;
585 // Alternative keyword requires a semicolon to prevent false positives.
586 if HasSemiColon or not IsAltNotation then
587 begin
588 TodoItem := TTodoItem.Create(aTLFile);
589 TodoItem.Done := IsDone;
590 TodoItem.AltNotation := IsAltNotation;
591 TodoItem.LineNumber := LineNumber;
592 TodoItem.Filename := aFileName;
593 if aTLFile<>nil then
594 aTLFile.Add(TodoItem);
595
596 if HasSemiColon then
597 begin
598 // Parse priority, owner and category
599 n := 1;
600 TempStr := '';
601 Strlen := Length(ParsingString);
602
603 while (n <= StrLen) and (ParsingString[n]<>cSemiColon) do
604 begin
605 aChar := ParsingString[n];
606 // Add char to temporary string
607 if (aChar<>cSemiColon) and (aChar<>cWhiteSpace) then
608 TempStr := TempStr + aChar
609 // Process temporary string
610 else
611 begin
612 SetItemFields(TodoItem, TempStr);
613 TempStr := '';
614 end;
615 inc(N);
616 end;
617
618 SetItemFields(TodoItem, TempStr);
619 Delete(ParsingString, 1, n);
620 end;
621
622 // Set item text
623 TodoItem.Text := ParsingString;
624 end;
625 end;
626
627
628 procedure TIDETodoWindow.FormCreate(Sender: TObject);
629 begin
630 fUpdating := False;
631 fScannedFiles := TAvlTree.Create(@CompareTLScannedFiles);
632
633 Caption := lisToDoList;
634
635 acRefresh.Hint := lisTodolistRefresh;
636 acGoto.Hint := listodoListGotoLine;
637
638 tbRefresh.Caption := dlgUnitDepRefresh;
639 tbGoto.Caption := lisToDoGoto;
640 tbExport.Caption := lisToDoExport;
641 tbHelp.Caption := lisHelp;
642
643 grbOptions.Caption := lisOptions;
644 chkListed.Caption := lisToDoListed;
645 chkListed.Hint := lisToDoListedHint;
646 chkUsed.Caption := lisToDoUsed;
647 chkUsed.Hint := lisToDoUsedHint;
648 chkPackages.Caption := lisPackages;
649 chkPackages.Hint := Format(lisPackagesHint, [lisToDoListed, lisToDoUsed]);
650 chkSourceEditor.Caption := lisSourceEditor;
651 chkSourceEditor.Hint := lisSourceEditorHint;
652
653 with lvTodo do
654 begin
655 Column[0].Caption := lisToDoLDone;
656 Column[1].Caption := lisToDoLDescription;
657 Column[1].Width := 700;
658 Column[2].Caption := lisToDoLPriority;
659 Column[3].Caption := lisToDoLFile;
660 Column[4].Caption := lisToDoLLine;
661 Column[5].Caption := lisToDoLOwner;
662 Column[6].Caption := listToDoLCategory;
663 end;
664
665 XMLPropStorage.FileName := Concat(AppendPathDelim(LazarusIDE.GetPrimaryConfigPath),
666 DefaultTodoListCfgFile);
667 XMLPropStorage.Active := True;
668 end;
669
670 procedure TIDETodoWindow.acGotoExecute(Sender: TObject);
671 var
672 CurFilename: String;
673 aTodoItem: TTodoItem;
674 aListItem: TListItem;
675 TheLine: integer;
676 begin
677 CurFilename:='';
678 aListItem:= lvtodo.Selected;
679 if Assigned(aListItem) and Assigned(aListItem.Data) then
680 begin
681 aTodoItem := TTodoItem(aListItem.Data);
682 CurFileName := aTodoItem.Filename;
683 TheLine := aTodoItem.LineNumber;
684 if Assigned(OnOpenFile) then
685 OnOpenFile(Self,CurFilename,TheLine)
686 else
687 LazarusIDE.DoOpenFileAndJumpToPos(CurFilename,Point(1,TheLine),-1,-1,-1,
688 [ofOnlyIfExists,ofRegularFile,ofVirtualFile,ofDoNotLoadResource]);
689 end;
690 end;
691
692 procedure TIDETodoWindow.acHelpExecute(Sender: TObject);
693 begin
694 // usual API from IdeHelpIntf don't work
695 OpenURL('http://wiki.freepascal.org/IDE_Window:_ToDo_List');
696 end;
697
698 procedure TIDETodoWindow.acExportExecute(Sender: TObject);
699 var
700 CommaList: TStringList;
701 s,t : string;
702 todoItm : TTodoItem;
703 i : integer;
704 begin
705 SaveDialog.FileName:='TodoList_'+FormatDateTime('YYYY_MM_DD',now);
706 if SaveDialog.Execute then
707 begin
708 CommaList:=TStringListUTF8.Create;
709 try
710 CommaList.Add('Done,Description,Priority,Module,Line,Owner,Category');
711 i:=0;
712 while i<lvTodo.Items.Count do
713 begin
714 todoItm:=TTodoItem(lvTodo.Items[i].Data);
715 if todoItm.Done then
716 s:='X,'
717 else
718 s:=' ,';
719 t:=DelChars(todoItm.Text,',');{Strip any commas that can cause a faulty csv file}
720 s:=s+t+','+IntToStr(todoItm.Priority)+','+todoItm.Filename+
721 ','+IntToStr(todoItm.LineNumber)+','+todoItm.Owner+','+todoItm.Category;
722 CommaList.Add(s);
723 i:=i+1;
724 end;
725 CommaList.SaveToFile(SaveDialog.FileName);
726 finally
727 CommaList.Clear;
728 CommaList.Free;
729 end;
730 end;
731 end;
732
733 procedure TIDETodoWindow.acRefreshExecute(Sender: TObject);
734 begin
735 UpdateTodos;
736 end;
737
738 procedure TIDETodoWindow.chkListedChange(Sender: TObject);
739 begin
740 UpdateTodos;
741 end;
742
743 procedure TIDETodoWindow.chkPackagesChange(Sender: TObject);
744 begin
745 UpdateTodos;
746 end;
747
748 procedure TIDETodoWindow.chkSourceEditorChange(Sender: TObject);
749 begin
750 UpdateTodos;
751 end;
752
753 procedure TIDETodoWindow.chkUsedChange(Sender: TObject);
754 begin
755 UpdateTodos;
756 end;
757
758 procedure TIDETodoWindow.FormCloseQuery(Sender: TObject; var CanClose: boolean);
759 begin
760 XMLPropStorage.Save;
761 end;
762
763 procedure TIDETodoWindow.AddListItem(aTodoItem: TTodoItem);
764 var
765 aListItem: TListItem;
766 aFilename: String;
767 begin
768 if Assigned(aTodoItem) then
769 begin
770 //DebugLn(['TfrmTodo.AddListItem ',aTodoItem.Filename,' ',aTodoItem.LineNumber]);
771 aListitem := lvTodo.Items.Add;
772 aListitem.Data := aTodoItem;
773 if aTodoItem.Done then
774 aListItem.Caption := 'X'
775 else
776 aListItem.Caption := ' ';
777 aListitem.SubItems.Add(aTodoItem.Text);
778 aListitem.SubItems.Add(IntToStr(aTodoItem.Priority));
779 aFilename:=aTodoItem.Filename;
780 if (BaseDirectory<>'') and FilenameIsAbsolute(aFilename) then
781 aFilename:=CreateRelativePath(aFilename,BaseDirectory);
782 aListitem.SubItems.Add(aFilename);
783 aListitem.SubItems.Add(IntToStr(aTodoItem.LineNumber));
784 aListitem.SubItems.Add(aTodoItem.Owner);
785 aListitem.SubItems.Add(aTodoItem.Category);
786 end;
787 end;
788
789 procedure TIDETodoWindow.ScanFile(aFileName: string);
790 var
791 ExpandedFilename: String;
792 AVLNode: TAvlTreeNode;
793 Tool: TCodeTool;
794 Code: TCodeBuffer;
795 CurFile: TTLScannedFile;
796 Src: String;
797 p: Integer;
798 NestedComment: Boolean;
799 CommentEnd: LongInt;
800 CommentStr: String;
801 CodeXYPosition: TCodeXYPosition;
802 begin
803 //DebugLn(['TfrmTodo.ScanFile ',aFileName]);
804 ExpandedFilename:=TrimFilename(aFileName);
805
806 Code:=CodeToolBoss.LoadFile(ExpandedFilename,true,false);
807 if Code=nil then begin
808 debugln(['TIDETodoWindow.ScanFile failed loading ',ExpandedFilename]);
809 exit;
810 end;
811 CodeToolBoss.Explore(Code,Tool,false,false); // ignore the result
812 if (Tool=nil) or (Tool.Scanner=nil) then begin
813 debugln(['TIDETodoWindow.ScanFile failed parsing ',Code.Filename]);
814 exit;
815 end;
816
817 AVLNode:=fScannedFiles.FindKey(Pointer(Tool.MainFilename),
818 @CompareAnsiStringWithTLScannedFile);
819 CurFile:=nil;
820 //DebugLn(['TfrmTodo.ScanFile ',Tool.MainFilename,' AVLNode=',AVLNode<>nil]);
821 if AVLNode<>nil then begin
822 CurFile:=TTLScannedFile(AVLNode.Data);
823 // Abort if this file has already been scanned and has not changed
824 if CurFile.CodeChangeStep=Tool.Scanner.ChangeStep then exit;
825 end;
826 //DebugLn(['TfrmTodo.ScanFile SCANNING ... ']);
827
828 // Add file name to list of scanned files
829 if CurFile=nil then begin
830 CurFile:=TTLScannedFile.Create;
831 CurFile.Filename:=Tool.MainFilename;
832 fScannedFiles.Add(CurFile);
833 end;
834 // save ChangeStep
835 CurFile.CodeChangeStep:=Tool.Scanner.ChangeStep;
836 //DebugLn(['TfrmTodo.ScanFile saved ChangeStep ',CurFile.CodeChangeStep,' ',Tool.Scanner.ChangeStep]);
837 // clear old items
838 CurFile.Clear;
839
840 Src:=Tool.Src;
841 p:=1;
842 NestedComment:=CodeToolBoss.GetNestedCommentsFlagForFile(Code.Filename);
843 repeat
844 p:=FindNextComment(Src,p);
845 if p>length(Src) then break;
846 CommentEnd:=FindCommentEnd(Src,p,NestedComment);
847 Tool.CleanPosToCaret(p,CodeXYPosition);
848 CommentStr:=copy(Src,p,CommentEnd-p);
849 //DebugLn(['TfrmTodo.ScanFile CommentStr="',CommentStr,'"']);
850 if Src[p]='/' then
851 CreateToDoItem(CurFile,CodeXYPosition.Code.Filename, '//', '', CommentStr, CodeXYPosition.Y)
852 else if Src[p]='{' then
853 CreateToDoItem(CurFile,CodeXYPosition.Code.Filename, '{', '}', CommentStr, CodeXYPosition.Y)
854 else if Src[p]='(' then
855 CreateToDoItem(CurFile,CodeXYPosition.Code.Filename, '(*', '*)', CommentStr, CodeXYPosition.Y);
856 p:=CommentEnd;
857 until false;
858 end;
859
860 procedure TIDETodoWindow.OnIdle(Sender: TObject; var Done: Boolean);
861 begin
862 if Done then ;
863 IdleConnected:=false;
864 UpdateTodos(true);
865 end;
866
867 { TTodoItem }
868
GetAsStringnull869 function TTodoItem.GetAsString: string;
870 begin
871 // Todo/Done in two notations
872 if AltNotation then
873 begin
874 if Done then
875 Result := 'DONE'
876 else
877 Result := 'TODO';
878 end
879 else
880 begin
881 if Done then
882 Result := '#done'
883 else
884 Result := '#todo';
885 end;
886 // Priority
887 if Priority > 0 then
888 Result := Result + ' '+IntToStr(Priority);
889 // Owner
890 if Owner <> '' then
891 Result := Result + ' -o'+Owner;
892 // Category
893 if Category <> '' then
894 Result := Result + ' -c'+Category;
895 // Text
896 Result := Result + ' : ' + Text;
897 end;
898
899 constructor TTodoItem.Create(aTLFile: TTLScannedFile);
900 begin
901 FTLFile:=aTLFile;
902 end;
903
TTodoItem.GetAsCommentnull904 function TTodoItem.GetAsComment: string;
905 begin
906 Result := '{ '+AsString+' }';
907 end;
908
909 { TTLScannedFile }
910
TTLScannedFile.GetCountnull911 function TTLScannedFile.GetCount: integer;
912 begin
913 if fItems=nil then
914 Result:=0
915 else
916 Result:=fItems.Count;
917 end;
918
TTLScannedFile.GetItemsnull919 function TTLScannedFile.GetItems(Index: integer): TTodoItem;
920 begin
921 Result:=TTodoItem(fItems[Index]);
922 end;
923
924 constructor TTLScannedFile.Create;
925 begin
926
927 end;
928
929 destructor TTLScannedFile.Destroy;
930 begin
931 Clear;
932 inherited Destroy;
933 end;
934
935 procedure TTLScannedFile.Clear;
936 var
937 i: Integer;
938 begin
939 if fItems<>nil then begin
940 for i:=0 to fItems.Count-1 do
941 TObject(fItems[i]).Free;
942 FreeAndNil(fItems);
943 end;
944 end;
945
946 procedure TTLScannedFile.Add(Item: TTodoItem);
947 begin
948 if fItems=nil then fItems:=TFPList.Create;
949 fItems.Add(Item);
950 end;
951
952 end.
953
954