1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Mattias Gaertner
22
23 Abstract:
24 Dictionary of identifiers.
25 Dialog to view and search the whole list.
26
27 ToDo:
28 -use identifier: check package version
29 -check for conflict: other unit with same name already in search path
30 -check for conflict: other identifier in scope, use unitname.identifier
31 -use gzip? lot of cpu, may be faster on first load
32 }
33 unit CodyIdentifiersDlg;
34
35 {$mode objfpc}{$H+}
36
37 interface
38
39 uses
40 Classes, SysUtils, LCLProc, contnrs, Laz_AVL_Tree,
41 // LCL
42 Forms, Controls, Dialogs, ButtonPanel, StdCtrls, ExtCtrls, LCLType, Buttons, Menus,
43 // IdeIntf
44 PackageIntf, LazIDEIntf, SrcEditorIntf, ProjectIntf,
45 CompOptsIntf, IDEDialogs, IDEMsgIntf, IDEExternToolIntf, ProjPackIntf,
46 // Codetools
47 CodeCache, BasicCodeTools, CustomCodeTool, CodeToolManager, UnitDictionary,
48 CodeTree, LinkScanner, DefineTemplates, FindDeclarationTool,
49 CodyStrConsts, CodyUtils, CodyOpts, FileProcs,
50 // LazUtils
51 LazFileUtils, LazFileCache, AvgLvlTree;
52
53 const
54 PackageNameFPCSrcDir = 'FPCSrcDir';
55 PackageNameDefault = 'PCCfg';
56 type
57 TCodyUnitDictionary = class;
58
59 { TCodyUDLoadSaveThread }
60
61 TCodyUDLoadSaveThread = class(TThread)
62 public
63 Load: boolean;
64 Dictionary: TCodyUnitDictionary;
65 Filename: string;
66 Done: boolean;
67 procedure Execute; override;
68 end;
69
70 { TCodyUnitDictionary }
71
72 TCodyUnitDictionary = class(TUnitDictionary)
73 private
74 FLoadAfterStartInS: integer;
75 FLoadSaveError: string;
76 FSaveIntervalInS: integer;
77 fTimer: TTimer;
78 FIdleConnected: boolean;
79 fQueuedTools: TAVLTree; // tree of TCustomCodeTool
80 fParsingTool: TCustomCodeTool;
81 fLoadSaveThread: TCodyUDLoadSaveThread;
82 fCritSec: TRTLCriticalSection;
83 fLoaded: boolean; // has loaded the file
84 fStartTime: TDateTime;
85 fClosing: boolean;
86 fCheckFiles: TStringToStringTree;
87 procedure CheckFiles;
88 procedure SetIdleConnected(AValue: boolean);
89 procedure SetLoadAfterStartInS(AValue: integer);
90 procedure SetLoadSaveError(AValue: string);
91 procedure SetSaveIntervalInS(AValue: integer);
92 procedure ToolTreeChanged(Tool: TCustomCodeTool; {%H-}NodesDeleting: boolean);
93 procedure OnIdle(Sender: TObject; var Done: Boolean);
94 procedure WaitForThread;
95 procedure OnTimer(Sender: TObject);
StartLoadSaveThreadnull96 function StartLoadSaveThread: boolean;
97 procedure OnIDEClose(Sender: TObject);
98 procedure OnApplyOptions(Sender: TObject);
99 public
100 constructor Create;
101 destructor Destroy; override;
102 procedure Load;
103 procedure Save;
104 property Loaded: boolean read fLoaded;
GetFilenamenull105 function GetFilename: string;
106 property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
107 property SaveIntervalInS: integer read FSaveIntervalInS write SetSaveIntervalInS;
108 property LoadAfterStartInS: integer read FLoadAfterStartInS write SetLoadAfterStartInS;
109 procedure BeginCritSec;
110 procedure EndCritSec;
111 procedure CheckFileAsync(aFilename: string); // check eventually if file exists and delete unit/group
112 property LoadSaveError: string read FLoadSaveError write SetLoadSaveError;
113 end;
114
115 TCodyIdentifierDlgAction = (
116 cidaUseIdentifier,
117 cidaJumpToIdentifier
118 );
119
120 TCodyIdentifierFilter = (
121 cifStartsWith,
122 cifContains
123 );
124
125 { TCodyIdentifier }
126
127 TCodyIdentifier = class
128 public
129 Identifier: string;
130 Unit_Name: string;
131 UnitFile: string;
132 GroupName: string;
133 GroupFile: string;
134 MatchExactly: boolean;
135 DirectUnit: boolean; // belongs to same owner
136 InUsedPackage: boolean;
137 PathDistance: integer; // how far is UnitFile from the current unit
138 UseCount: int64;
139 constructor Create(const TheIdentifier, TheUnitName, TheUnitFile,
140 ThePackageName, ThePackageFile: string; TheMatchExactly: boolean);
141 end;
142
143 { TCodyIdentifiersDlg }
144
145 TCodyIdentifiersDlg = class(TForm)
146 AddToImplementationUsesCheckBox: TCheckBox;
147 ButtonPanel1: TButtonPanel;
148 ContainsRadioButton: TRadioButton;
149 FilterEdit: TEdit;
150 HideOtherProjectsCheckBox: TCheckBox;
151 InfoLabel: TLabel;
152 ItemsListBox: TListBox;
153 JumpMenuItem: TMenuItem;
154 DeleteSeparatorMenuItem: TMenuItem;
155 DeleteUnitMenuItem: TMenuItem;
156 DeletePackageMenuItem: TMenuItem;
157 StartsRadioButton: TRadioButton;
158 UseMenuItem: TMenuItem;
159 PackageLabel: TLabel;
160 PopupMenu1: TPopupMenu;
161 UnitLabel: TLabel;
162 procedure ButtonPanel1HelpButtonClick(Sender: TObject);
163 procedure DeletePackageClick(Sender: TObject);
164 procedure DeleteUnitClick(Sender: TObject);
165 procedure UseIdentifierClick(Sender: TObject);
166 procedure ContainsRadioButtonClick(Sender: TObject);
167 procedure FilterEditChange(Sender: TObject);
168 procedure FilterEditKeyDown(Sender: TObject; var Key: Word;
169 {%H-}Shift: TShiftState);
170 procedure FormDestroy(Sender: TObject);
171 procedure JumpButtonClick(Sender: TObject);
172 procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
173 procedure FormCreate(Sender: TObject);
174 procedure HideOtherProjectsCheckBoxChange(Sender: TObject);
175 procedure ItemsListBoxClick(Sender: TObject);
176 procedure ItemsListBoxSelectionChange(Sender: TObject; {%H-}User: boolean);
177 procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean);
178 procedure PopupMenu1Popup(Sender: TObject);
179 procedure StartsRadioButtonClick(Sender: TObject);
180 private
181 FDlgAction: TCodyIdentifierDlgAction;
182 FJumpButton: TBitBtn;
183 FLastFilter: string;
184 FLastHideOtherProjects: boolean;
185 FIdleConnected: boolean;
186 FMaxItems: integer;
187 FItems: TObjectList; // list of TCodyIdentifier
188 FLastFilterType: TCodyIdentifierFilter;
189 procedure SetDlgAction(NewAction: TCodyIdentifierDlgAction);
190 procedure SetIdleConnected(AValue: boolean);
191 procedure SetMaxItems(AValue: integer);
192 procedure UpdateGeneralInfo;
193 procedure UpdateItemsList;
194 procedure UpdateItemsListIfFilterChanged;
195 procedure SortItems;
196 procedure UpdateIdentifierInfo;
GetFilterEditTextnull197 function GetFilterEditText: string;
FindSelectedIdentifiernull198 function FindSelectedIdentifier: TCodyIdentifier;
FindSelectedItemnull199 function FindSelectedItem(out Identifier, UnitFilename,
200 GroupName, GroupFilename: string): boolean;
201 procedure UpdateCurOwnerOfUnit;
202 procedure AddToUsesSection(JumpToSrcError: boolean);
UpdateToolnull203 function UpdateTool(JumpToSrcError: boolean): boolean;
AddButtonnull204 function AddButton: TBitBtn;
GetCurOwnerCompilerOptionsnull205 function GetCurOwnerCompilerOptions: TLazCompilerOptions;
206 public
207 CurIdentifier: string;
208 CurIdentStart: integer; // column
209 CurIdentEnd: integer; // column
210 CurInitError: TCUParseError;
211 CurTool: TCodeTool;
212 CurCleanPos: integer;
213 CurNode: TCodeTreeNode;
214 CurCodePos: TCodeXYPosition;
215 CurSrcEdit: TSourceEditorInterface;
216 CurMainFilename: string; // if CurSrcEdit is an include file, then CurMainFilename<>CurSrcEdit.Filename
217 CurMainCode: TCodeBuffer;
218 CurInImplementation: Boolean;
219
220 CurOwner: TObject; // only valid after UpdateCurOwnerOfUnit and till next event
221 CurUnitPath: string; // depends on CurOwner
222 CurOwnerDir: string; // depends on CurOwner
223
224 NewIdentifier: string;
225 NewUnitFilename: string;
226 NewGroupName: string;
227 NewGroupFilename: string;
228
Initnull229 function Init: boolean;
230 procedure UseIdentifier;
231 procedure JumpToIdentifier;
232 property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
233 property MaxItems: integer read FMaxItems write SetMaxItems;
OwnerToStringnull234 function OwnerToString(AnOwner: TObject): string;
235 property DlgAction: TCodyIdentifierDlgAction read FDlgAction;
GetFilterTypenull236 function GetFilterType: TCodyIdentifierFilter;
237 end;
238
239 { TQuickFixIdentifierNotFoundShowDictionary }
240
241 TQuickFixIdentifierNotFoundShowDictionary = class(TMsgQuickFix)
242 public
IsApplicablenull243 function IsApplicable(Msg: TMessageLine; out Identifier: string): boolean;
244 procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
245 procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
246 end;
247
248 var
249 CodyUnitDictionary: TCodyUnitDictionary = nil;
250
251 procedure ShowUnitDictionaryDialog(Sender: TObject);
252 procedure InitUnitDictionary;
253
CompareCodyIdentifiersAlphaScopeUsenull254 function CompareCodyIdentifiersAlphaScopeUse(Item1, Item2: Pointer): integer;
CompareCodyIdentifiersScopeAlphanull255 function CompareCodyIdentifiersScopeAlpha(Item1, Item2: Pointer): integer;
CompareCodyIdentifiersAlphanull256 function CompareCodyIdentifiersAlpha(Item1, Item2: Pointer): integer;
CompareCodyIdentifiersScopenull257 function CompareCodyIdentifiersScope(Item1, Item2: Pointer): integer;
CompareCodyIdentifiersUseCountnull258 function CompareCodyIdentifiersUseCount(Item1, Item2: Pointer): integer;
259
260 implementation
261
262 {$R *.lfm}
263
264 procedure ShowUnitDictionaryDialog(Sender: TObject);
265 var
266 Dlg: TCodyIdentifiersDlg;
267 begin
268 Dlg:=TCodyIdentifiersDlg.Create(nil);
269 try
270 if not Dlg.Init then exit;
271 if Dlg.ShowModal=mrOk then begin
272 case Dlg.DlgAction of
273 cidaUseIdentifier: Dlg.UseIdentifier;
274 cidaJumpToIdentifier: Dlg.JumpToIdentifier;
275 end;
276 end;
277 finally
278 Dlg.Free;
279 end;
280 end;
281
282 procedure InitUnitDictionary;
283 begin
284 CodyUnitDictionary:=TCodyUnitDictionary.Create;
285 RegisterIDEMsgQuickFix(TQuickFixIdentifierNotFoundShowDictionary.Create);
286 end;
287
CompareCodyIdentifiersAlphaScopeUsenull288 function CompareCodyIdentifiersAlphaScopeUse(Item1, Item2: Pointer): integer;
289 begin
290 Result:=CompareCodyIdentifiersAlpha(Item1,Item2);
291 //if Result<>0 then debugln(['CompareCodyIdentifiersAlphaScopeUse Alpha diff: ',TCodyIdentifier(Item1).Identifier,' ',TCodyIdentifier(Item2).Identifier]);
292 if Result<>0 then exit;
293 Result:=CompareCodyIdentifiersScope(Item1,Item2);
294 //if Result<>0 then debugln(['CompareCodyIdentifiersAlphaScopeUse Scope diff: ',TCodyIdentifier(Item1).Identifier,' ',TCodyIdentifier(Item1).UnitFile,' ',TCodyIdentifier(Item2).UnitFile]);
295 if Result<>0 then exit;
296 Result:=CompareCodyIdentifiersUseCount(Item1,Item2);
297 //if Result<>0 then debugln(['CompareCodyIdentifiersAlphaScopeUse UseCount diff: ',TCodyIdentifier(Item1).Identifier,' ',TCodyIdentifier(Item1).UseCount,' ',TCodyIdentifier(Item2).UseCount]);
298 end;
299
CompareCodyIdentifiersScopeAlphanull300 function CompareCodyIdentifiersScopeAlpha(Item1, Item2: Pointer): integer;
301 begin
302 Result:=CompareCodyIdentifiersScope(Item1,Item2);
303 if Result<>0 then exit;
304 Result:=CompareCodyIdentifiersAlpha(Item1,Item2);
305 end;
306
CheckFlagnull307 function CheckFlag(Flag1, Flag2: boolean; var r: integer): boolean;
308 begin
309 if Flag1=Flag2 then exit(false);
310 Result:=true;
311 if Flag1 then r:=-1 else r:=1;
312 end;
313
CompareCodyIdentifiersAlphanull314 function CompareCodyIdentifiersAlpha(Item1, Item2: Pointer): integer;
315 // positive is sorted on top
316 var
317 i1: TCodyIdentifier absolute Item1;
318 i2: TCodyIdentifier absolute Item2;
319 begin
320 Result:=0;
321 // an exact match is better
322 if CheckFlag(i1.MatchExactly,i2.MatchExactly,Result) then exit;
323 // otherwise alphabetically
324 Result:=-CompareIdentifiers(PChar(i1.Identifier),PChar(i2.Identifier));
325 end;
326
CompareCodyIdentifiersScopenull327 function CompareCodyIdentifiersScope(Item1, Item2: Pointer): integer;
328 // positive is sorted on top
329 var
330 i1: TCodyIdentifier absolute Item1;
331 i2: TCodyIdentifier absolute Item2;
332 begin
333 Result:=0;
334 // an exact match is better
335 if CheckFlag(i1.MatchExactly,i2.MatchExactly,Result) then begin
336 //debugln(['CompareCodyIdentifiersScope ',i1.Identifier,' MatchExactly 1=',i1.MatchExactly,' 2=',i2.MatchExactly]);
337 exit;
338 end;
339 // an unit of the owner is better
340 if CheckFlag(i1.DirectUnit,i2.DirectUnit,Result) then begin
341 //debugln(['CompareCodyIdentifiersScope ',i1.Identifier,' DirectUnit 1=',i1.DirectUnit,' 2=',i2.DirectUnit]);
342 exit;
343 end;
344 // an unit in a used package is better
345 if CheckFlag(i1.InUsedPackage,i2.InUsedPackage,Result) then begin
346 //debugln(['CompareCodyIdentifiersScope ',i1.Identifier,' InUsedPackage 1=',i1.InUsedPackage,' 2=',i2.InUsedPackage]);
347 exit;
348 end;
349 // a fpc unit is better
350 if CheckFlag(i1.GroupName=PackageNameDefault,i2.GroupName=PackageNameDefault,Result) then begin
351 //debugln(['CompareCodyIdentifiersScope fpc.cfg unit ',i1.Identifier,' GroupName 1=',i1.GroupName,' 2=',i2.GroupName]);
352 exit;
353 end;
354 if CheckFlag(i1.GroupName=PackageNameFPCSrcDir,i2.GroupName=PackageNameFPCSrcDir,Result) then begin
355 //debugln(['CompareCodyIdentifiersScope fpcsrcdir unit ',i1.Identifier,' GroupName 1=',i1.GroupName,' 2=',i2.GroupName]);
356 exit;
357 end;
358 // a near directory is better
359 Result:=i1.PathDistance-i2.PathDistance;
360 if Result<>0 then begin
361 //debugln(['CompareCodyIdentifiersScope ',i1.Identifier,' PathDistance 1=',i1.PathDistance,' 2=',i2.PathDistance]);
362 end;
363 end;
364
CompareCodyIdentifiersUseCountnull365 function CompareCodyIdentifiersUseCount(Item1, Item2: Pointer): integer;
366 var
367 i1: TCodyIdentifier absolute Item1;
368 i2: TCodyIdentifier absolute Item2;
369 begin
370 if i1.UseCount>i2.UseCount then
371 exit(-1)
372 else if i1.UseCount<i2.UseCount then
373 exit(1)
374 else
375 exit(0);
376 end;
377
378 { TQuickFixIdentifierNotFoundShowDictionary }
379
IsApplicablenull380 function TQuickFixIdentifierNotFoundShowDictionary.IsApplicable(
381 Msg: TMessageLine; out Identifier: string): boolean;
382 var
383 Dummy: string;
384 begin
385 Result:=IDEFPCParser.MsgLineIsId(Msg,5000,Identifier,Dummy);
386 end;
387
388 procedure TQuickFixIdentifierNotFoundShowDictionary.CreateMenuItems(
389 Fixes: TMsgQuickFixes);
390 var
391 Msg: TMessageLine;
392 Identifier: string;
393 i: Integer;
394 begin
395 for i:=0 to Fixes.LineCount-1 do begin
396 Msg:=Fixes.Lines[i];
397 if not IsApplicable(Msg,Identifier) then continue;
398 Fixes.AddMenuItem(Self, Msg, Format(crsShowCodyDict, [Identifier]));
399 exit;
400 end;
401 end;
402
403 procedure TQuickFixIdentifierNotFoundShowDictionary.QuickFix(
404 Fixes: TMsgQuickFixes; Msg: TMessageLine);
405 var
406 Identifier: string;
407 begin
408 if not IsApplicable(Msg,Identifier) then exit;
409 if LazarusIDE.DoOpenFileAndJumpToPos(Msg.GetFullFilename,
410 Point(Msg.Column,Msg.Line),-1,-1,-1,[ofOnlyIfExists,ofRegularFile])<>mrOk then exit;
411 ShowUnitDictionaryDialog(nil);
412 end;
413
414 { TCodyIdentifier }
415
416 constructor TCodyIdentifier.Create(const TheIdentifier, TheUnitName,
417 TheUnitFile, ThePackageName, ThePackageFile: string; TheMatchExactly: boolean
418 );
419 begin
420 Identifier:=TheIdentifier;
421 Unit_Name:=TheUnitName;
422 UnitFile:=TheUnitFile;
423 GroupName:=ThePackageName;
424 GroupFile:=ThePackageFile;
425 MatchExactly:=TheMatchExactly;
426 end;
427
428 { TCodyUDLoadSaveThread }
429
430 procedure TCodyUDLoadSaveThread.Execute;
431 var
432 UncompressedMS: TMemoryStream;
433 TempFilename: String;
434 BugFilename: String;
435 begin
436 Dictionary.LoadSaveError:='';
437 FreeOnTerminate:=true;
438 try
439 if Load then begin
440 // load
441 //debugln('TCodyUDLoadSaveThread.Execute loading '+Filename+' exists='+dbgs(FileExistsUTF8(Filename)));
442 // Note: if loading fails, then the format or read permissions are wrong
443 // mark as loaded, so that the next save will create a valid one
444 Dictionary.fLoaded:=true;
445 if FileExistsUTF8(Filename) then begin
446 UncompressedMS:=TMemoryStream.Create;
447 try
448 UncompressedMS.LoadFromFile(Filename);
449 UncompressedMS.Position:=0;
450 Dictionary.BeginCritSec;
451 try
452 Dictionary.LoadFromStream(UncompressedMS,true);
453 finally
454 Dictionary.EndCritSec;
455 end;
456 finally
457 UncompressedMS.Free;
458 end;
459 end;
460 end else begin
461 // save
462 //debugln('TCodyUDLoadSaveThread.Execute saving '+Filename);
463 TempFilename:='';
464 UncompressedMS:=TMemoryStream.Create;
465 try
466 Dictionary.BeginCritSec;
467 try
468 Dictionary.SaveToStream(UncompressedMS);
469 finally
470 Dictionary.EndCritSec;
471 end;
472 UncompressedMS.Position:=0;
473 // reduce the risk of file corruption due to crashes while saving:
474 // save to a temporary file and then rename
475 TempFilename:=FileProcs.GetTempFilename(Filename,'writing_tmp_');
476 UncompressedMS.SaveToFile(TempFilename);
477 if FileExistsUTF8(Filename) and (not DeleteFileUTF8(Filename)) then
478 raise Exception.Create(Format(crsUnableToDelete, [Filename]));
479 if not RenameFileUTF8(TempFilename,Filename) then
480 raise Exception.Create(Format(crsUnableToRenameTo, [TempFilename,
481 Filename]));
482 finally
483 UncompressedMS.Free;
484 if FileExistsUTF8(TempFilename) then
485 DeleteFileUTF8(TempFilename);
486 end;
487 end;
488 except
489 on E: Exception do begin
490 debugln(['WARNING: TCodyUDLoadSaveThread.Execute Load=',Load,' ',E.Message]);
491 Dictionary.LoadSaveError:=E.Message;
492 // DumpExceptionBackTrace; gives wrong line numbers multithreaded
493 if E is ECTUnitDictionaryLoadError then begin
494 BugFilename:=Filename+'.bug';
495 debugln(['TCodyUDLoadSaveThread.Execute saving buggy file for inspection to "',BugFilename,'"']);
496 try
497 RenameFileUTF8(Filename,BugFilename);
498 except
499 end;
500 end;
501 end;
502 end;
503 Done:=true;
504 Dictionary.BeginCritSec;
505 try
506 Dictionary.fLoadSaveThread:=nil;
507 finally
508 Dictionary.EndCritSec;
509 end;
510 WakeMainThread(nil);
511 //debugln('TCodyUDLoadSaveThread.Execute END');
512 end;
513
514 { TCodyUnitDictionary }
515
516 procedure TCodyUnitDictionary.ToolTreeChanged(Tool: TCustomCodeTool;
517 NodesDeleting: boolean);
518 begin
519 if fParsingTool=Tool then exit;
520 if not (Tool is TFindDeclarationTool) then exit;
521 if TFindDeclarationTool(Tool).GetSourceType<>ctnUnit then exit;
522 //debugln(['TCodyUnitDictionary.ToolTreeChanged ',Tool.MainFilename]);
523 if fQueuedTools.Find(Tool)<>nil then exit;
524 fQueuedTools.Add(Tool);
525 IdleConnected:=true;
526 end;
527
528 procedure TCodyUnitDictionary.OnIdle(Sender: TObject; var Done: Boolean);
529 var
530 OwnerList: TFPList;
531 i: Integer;
532 Pkg: TIDEPackage;
533 UDUnit: TUDUnit;
534 UDGroup: TUDUnitGroup;
535 ok: Boolean;
536 OldChangeStamp: Int64;
537 UnitSet: TFPCUnitSetCache;
538 CfgCache: TPCTargetConfigCache;
539 DefaultFile: String;
540 begin
541 // check without critical section if currently loading/saving
542 if fLoadSaveThread<>nil then
543 exit;
544
545 if fQueuedTools.Root<>nil then begin
546 fParsingTool:=TCustomCodeTool(fQueuedTools.Root.Data);
547 fQueuedTools.Delete(fQueuedTools.Root);
548 //debugln(['TCodyUnitDictionary.OnIdle parsing ',fParsingTool.MainFilename]);
549 OwnerList:=nil;
550 try
551 ok:=false;
552 OldChangeStamp:=ChangeStamp;
553 try
554 BeginCritSec;
555 try
556 UDUnit:=ParseUnit(fParsingTool.MainFilename);
557 finally
558 EndCritSec;
559 end;
560 ok:=true;
561 except
562 // parse error
563 end;
564 //ConsistencyCheck;
565 if Ok then begin
566 OwnerList:=PackageEditingInterface.GetPossibleOwnersOfUnit(
567 fParsingTool.MainFilename,[piosfIncludeSourceDirectories]);
568 if (OwnerList<>nil) then begin
569 BeginCritSec;
570 try
571 for i:=0 to OwnerList.Count-1 do begin
572 if TObject(OwnerList[i]) is TIDEPackage then begin
573 Pkg:=TIDEPackage(OwnerList[i]);
574 if Pkg.IsVirtual then continue;
575 UDGroup:=AddUnitGroup(Pkg.Filename,Pkg.Name);
576 //debugln(['TCodyUnitDictionary.OnIdle Pkg=',Pkg.Filename,' Name=',Pkg.Name]);
577 if UDGroup=nil then begin
578 debugln(['ERROR: TCodyUnitDictionary.OnIdle unable to AddUnitGroup: File=',Pkg.Filename,' Name=',Pkg.Name]);
579 exit;
580 end;
581 UDGroup.AddUnit(UDUnit);
582 //ConsistencyCheck;
583 end;
584 end;
585 finally
586 EndCritSec;
587 end;
588 end;
589
590 // check if in FPC source directory
591 UnitSet:=CodeToolBoss.GetUnitSetForDirectory('');
592 if UnitSet<>nil then begin
593 if (UnitSet.FPCSourceDirectory<>'')
594 and FileIsInPath(fParsingTool.MainFilename,UnitSet.FPCSourceDirectory)
595 then begin
596 // unit in FPC source directory
597 BeginCritSec;
598 try
599 UDGroup:=AddUnitGroup(
600 AppendPathDelim(UnitSet.FPCSourceDirectory)+PackageNameFPCSrcDir+'.lpk',
601 PackageNameFPCSrcDir);
602 UDGroup.AddUnit(UDUnit);
603 finally
604 EndCritSec;
605 end;
606 end else begin
607 CfgCache:=UnitSet.GetConfigCache(false);
608 if (CfgCache<>nil) and (CfgCache.Units<>nil) then begin
609 DefaultFile:=CfgCache.Units[ExtractFileNameOnly(fParsingTool.MainFilename)];
610 if CompareFilenames(DefaultFile,fParsingTool.MainFilename)=0 then
611 begin
612 // unit source is in default compiler unit path
613 BeginCritSec;
614 try
615 UDGroup:=AddUnitGroup(
616 ExtractFilePath(UnitSet.CompilerFilename)+PackageNameDefault+'.lpk',
617 PackageNameDefault);
618 UDGroup.AddUnit(UDUnit);
619 finally
620 EndCritSec;
621 end;
622 end;
623 end;
624 end;
625 end;
626
627 if ChangeStamp<>OldChangeStamp then begin
628 if (fTimer=nil) and (not fClosing) then begin
629 fTimer:=TTimer.Create(nil);
630 fTimer.Interval:=SaveIntervalInS*1000;
631 fTimer.OnTimer:=@OnTimer;
632 end;
633 if fTimer<>nil then
634 fTimer.Enabled:=true;
635 end;
636 end;
637 finally
638 fParsingTool:=nil;
639 OwnerList.Free;
640 end;
641 end else if fCheckFiles<>nil then begin
642 CheckFiles;
643 end else begin
644 // nothing to do, maybe it's time to load the database
645 if fStartTime=0 then
646 fStartTime:=Now
647 else if (fLoadSaveThread=nil) and (not fLoaded)
648 and (Abs(Now-fStartTime)*86400>=LoadAfterStartInS) then
649 StartLoadSaveThread;
650 end;
651 Done:=fQueuedTools.Count=0;
652 if Done then
653 IdleConnected:=false;
654 end;
655
656 procedure TCodyUnitDictionary.WaitForThread;
657 begin
658 repeat
659 BeginCritSec;
660 try
661 if fLoadSaveThread=nil then exit;
662 finally
663 EndCritSec;
664 end;
665 Sleep(10);
666 until false;
667 end;
668
669 procedure TCodyUnitDictionary.OnTimer(Sender: TObject);
670 begin
671 if StartLoadSaveThread then
672 if fTimer<>nil then
673 fTimer.Enabled:=false;
674 end;
675
GetFilenamenull676 function TCodyUnitDictionary.GetFilename: string;
677 begin
678 Result:=AppendPathDelim(LazarusIDE.GetPrimaryConfigPath)+'codyunitdictionary.txt';
679 end;
680
StartLoadSaveThreadnull681 function TCodyUnitDictionary.StartLoadSaveThread: boolean;
682 begin
683 Result:=false;
684 if (Self=nil) or fClosing then exit;
685 if (Application=nil) or (CodyUnitDictionary=nil) then exit;
686 //debugln(['TCodyUnitDictionary.StartLoadSaveThread ',fLoadSaveThread<>nil]);
687 BeginCritSec;
688 try
689 if fLoadSaveThread<>nil then exit;
690 finally
691 EndCritSec;
692 end;
693 Result:=true;
694 fLoadSaveThread:=TCodyUDLoadSaveThread.Create(true);
695 fLoadSaveThread.Load:=not fLoaded;
696 fLoadSaveThread.Dictionary:=Self;
697 fLoadSaveThread.Filename:=GetFilename;
698 fLoadSaveThread.Start;
699 end;
700
701 procedure TCodyUnitDictionary.OnIDEClose(Sender: TObject);
702 begin
703 fClosing:=true;
704 FreeAndNil(fTimer);
705 end;
706
707 procedure TCodyUnitDictionary.OnApplyOptions(Sender: TObject);
708 begin
709 LoadAfterStartInS:=CodyOptions.UDLoadDelayInS;
710 SaveIntervalInS:=CodyOptions.UDSaveIntervalInS;
711 end;
712
713 procedure TCodyUnitDictionary.SetIdleConnected(AValue: boolean);
714 begin
715 if FIdleConnected=AValue then Exit;
716 FIdleConnected:=AValue;
717 if Application=nil then exit;
718 if IdleConnected then
719 Application.AddOnIdleHandler(@OnIdle)
720 else
721 Application.RemoveOnIdleHandler(@OnIdle);
722 end;
723
724 procedure TCodyUnitDictionary.CheckFiles;
725 var
726 aFilename: String;
727 StrItem: PStringToStringItem;
728 List: TStringList;
729 UDGroup: TUDUnitGroup;
730 CurUnit: TUDUnit;
731 begin
732 List:=TStringList.Create;
733 try
734 for StrItem in fCheckFiles do
735 List.Add(StrItem^.Name);
736 FreeAndNil(fCheckFiles);
737 for aFilename in List do begin
738 if FileExistsCached(aFilename) then continue;
739 BeginCritSec;
740 try
741 UDGroup:=FindGroupWithFilename(aFilename);
742 if UDGroup<>nil then
743 DeleteGroup(UDGroup,true);
744 CurUnit:=FindUnitWithFilename(aFilename);
745 if CurUnit<>nil then
746 DeleteUnit(CurUnit,true);
747 finally
748 EndCritSec;
749 end;
750 end;
751 finally
752 List.Free;
753 end;
754 end;
755
756 procedure TCodyUnitDictionary.SetLoadAfterStartInS(AValue: integer);
757 begin
758 if FLoadAfterStartInS=AValue then Exit;
759 FLoadAfterStartInS:=AValue;
760 end;
761
762 procedure TCodyUnitDictionary.SetLoadSaveError(AValue: string);
763 begin
764 BeginCritSec;
765 try
766 FLoadSaveError:=AValue;
767 finally
768 EndCritSec;
769 end;
770 end;
771
772 procedure TCodyUnitDictionary.SetSaveIntervalInS(AValue: integer);
773 begin
774 if FSaveIntervalInS=AValue then Exit;
775 FSaveIntervalInS:=AValue;
776 if fTimer<>nil then
777 fTimer.Interval:=SaveIntervalInS;
778 end;
779
780 constructor TCodyUnitDictionary.Create;
781 begin
782 inherited Create;
783 FSaveIntervalInS:=60*3; // every 3 minutes
784 FLoadAfterStartInS:=3;
785 InitCriticalSection(fCritSec);
786 fQueuedTools:=TAVLTree.Create;
787 CodeToolBoss.AddHandlerToolTreeChanging(@ToolTreeChanged);
788 LazarusIDE.AddHandlerOnIDEClose(@OnIDEClose);
789 CodyOptions.AddHandlerApply(@OnApplyOptions);
790 end;
791
792 destructor TCodyUnitDictionary.Destroy;
793 begin
794 fClosing:=true;
795 CodyOptions.RemoveHandlerApply(@OnApplyOptions);
796 FreeAndNil(fCheckFiles);
797 CodeToolBoss.RemoveHandlerToolTreeChanging(@ToolTreeChanged);
798 FreeAndNil(fTimer);
799 WaitForThread;
800 IdleConnected:=false;
801 FreeAndNil(fQueuedTools);
802 inherited Destroy;
803 DoneCriticalsection(fCritSec);
804 end;
805
806 procedure TCodyUnitDictionary.Load;
807 begin
808 if fLoaded then exit;
809 WaitForThread;
810 if fLoaded then exit;
811 StartLoadSaveThread;
812 WaitForThread;
813 //debugln(['TCodyUnitDictionary.Load ']);
814 //ConsistencyCheck;
815 end;
816
817 procedure TCodyUnitDictionary.Save;
818 begin
819 WaitForThread;
820 fLoaded:=true;
821 StartLoadSaveThread;
822 WaitForThread;
823 end;
824
825 procedure TCodyUnitDictionary.BeginCritSec;
826 begin
827 EnterCriticalsection(fCritSec);
828 end;
829
830 procedure TCodyUnitDictionary.EndCritSec;
831 begin
832 LeaveCriticalsection(fCritSec);
833 end;
834
835 procedure TCodyUnitDictionary.CheckFileAsync(aFilename: string);
836 begin
837 if fClosing then exit;
838 if (aFilename='') or (not FilenameIsAbsolute(aFilename)) then exit;
839 if fCheckFiles=nil then
840 fCheckFiles:=TStringToStringTree.Create(false);
841 fCheckFiles[aFilename]:='1';
842 IdleConnected:=true;
843 end;
844
845 { TCodyIdentifiersDlg }
846
847 procedure TCodyIdentifiersDlg.FilterEditChange(Sender: TObject);
848 begin
849 if FItems=nil then exit;
850 IdleConnected:=true;
851 end;
852
853 procedure TCodyIdentifiersDlg.UseIdentifierClick(Sender: TObject);
854 begin
855 SetDlgAction(cidaUseIdentifier);
856 end;
857
858 procedure TCodyIdentifiersDlg.ButtonPanel1HelpButtonClick(Sender: TObject);
859 begin
860 OpenCodyHelp('#Identifier_Dictionary');
861 end;
862
863 procedure TCodyIdentifiersDlg.DeletePackageClick(Sender: TObject);
864 var
865 Identifier: string;
866 UnitFilename: string;
867 GroupName: string;
868 GroupFilename: string;
869 Group: TUDUnitGroup;
870 s: String;
871 begin
872 if not FindSelectedItem(Identifier, UnitFilename, GroupName, GroupFilename)
873 then exit;
874 if GroupFilename='' then exit;
875 s:=Format(crsReallyDeleteThePackageFromTheDatabaseNoteThisDoe, [#13, #13,
876 #13, GroupFilename]);
877 if IDEMessageDialog(crsDeletePackage, s, mtConfirmation, [mbYes, mbNo], '')<>
878 mrYes
879 then exit;
880 Group:=CodyUnitDictionary.FindGroupWithFilename(GroupFilename);
881 if Group=nil then exit;
882 CodyUnitDictionary.DeleteGroup(Group,true);
883 UpdateGeneralInfo;
884 UpdateItemsList;
885 end;
886
887 procedure TCodyIdentifiersDlg.DeleteUnitClick(Sender: TObject);
888 var
889 Identifier: string;
890 UnitFilename: string;
891 GroupName: string;
892 GroupFilename: string;
893 CurUnit: TUDUnit;
894 s: String;
895 begin
896 if not FindSelectedItem(Identifier, UnitFilename, GroupName, GroupFilename)
897 then exit;
898 s:=Format(crsReallyDeleteTheUnitFromTheDatabaseNoteThisDoesNo, [#13, #13,
899 #13, UnitFilename]);
900 if GroupFilename<>'' then
901 s+=#13+Format(crsIn, [GroupFilename]);
902 if IDEMessageDialog(crsDeleteUnit, s, mtConfirmation, [mbYes, mbNo], '')<>
903 mrYes
904 then exit;
905 CurUnit:=CodyUnitDictionary.FindUnitWithFilename(UnitFilename);
906 if CurUnit=nil then exit;
907 CodyUnitDictionary.DeleteUnit(CurUnit,true);
908 UpdateGeneralInfo;
909 UpdateItemsList;
910 end;
911
912 procedure TCodyIdentifiersDlg.ContainsRadioButtonClick(Sender: TObject);
913 begin
914 StartsRadioButton.Checked:=not ContainsRadioButton.Checked;
915 IdleConnected:=true;
916 end;
917
918 procedure TCodyIdentifiersDlg.FilterEditKeyDown(Sender: TObject; var Key: Word;
919 Shift: TShiftState);
920 var
921 i: Integer;
922 begin
923 i:=ItemsListBox.ItemIndex;
924 case Key of
925 VK_DOWN:
926 if i<0 then
927 ItemsListBox.ItemIndex:=0
928 else if i<ItemsListBox.Count-1 then
929 ItemsListBox.ItemIndex:=i+1;
930 VK_UP:
931 if i<0 then
932 ItemsListBox.ItemIndex:=ItemsListBox.Count-1
933 else if i>0 then
934 ItemsListBox.ItemIndex:=i-1;
935 end;
936 end;
937
938 procedure TCodyIdentifiersDlg.FormDestroy(Sender: TObject);
939 begin
940 IdleConnected:=false;
941 end;
942
943 procedure TCodyIdentifiersDlg.JumpButtonClick(Sender: TObject);
944 begin
945 SetDlgAction(cidaJumpToIdentifier);
946 end;
947
948 procedure TCodyIdentifiersDlg.FormClose(Sender: TObject;
949 var CloseAction: TCloseAction);
950 begin
951 IdleConnected:=false;
952 CodyOptions.PreferImplementationUsesSection:=
953 AddToImplementationUsesCheckBox.Checked;
954 FreeAndNil(FItems);
955 end;
956
957 procedure TCodyIdentifiersDlg.FormCreate(Sender: TObject);
958 begin
959 Caption:=crsCodyIdentifierDictionary;
960 ButtonPanel1.HelpButton.OnClick:=@ButtonPanel1HelpButtonClick;
961 ButtonPanel1.OKButton.Caption:=crsUseIdentifier;
962 ButtonPanel1.OKButton.OnClick:=@UseIdentifierClick;
963 FMaxItems:=40;
964 FilterEdit.TextHint:=crsFilter;
965 FItems:=TObjectList.Create;
966 HideOtherProjectsCheckBox.Checked:=true;
967 HideOtherProjectsCheckBox.Caption:=crsHideUnitsOfOtherProjects;
968 AddToImplementationUsesCheckBox.Caption:=
969 crsAddUnitToImplementationUsesSection;
970 AddToImplementationUsesCheckBox.Hint:=
971 crsIfIdentifierIsAddedToTheImplementationSectionAndNe;
972
973 FJumpButton:=AddButton;
974 FJumpButton.Name:='JumpButton';
975 FJumpButton.OnClick:=@JumpButtonClick;
976 FJumpButton.Caption:= crsJumpTo;
977
978 StartsRadioButton.Checked:=true;
979 StartsRadioButton.Caption:=crsStarts;
980 StartsRadioButton.Hint:=crsShowOnlyIdentifiersStartingWithFilterText;
981 ContainsRadioButton.Checked:=false;
982 ContainsRadioButton.Caption:=crsContains;
983 ContainsRadioButton.Hint:=crsShowOnlyIdentifiersContainingFilterText;
984 end;
985
986 procedure TCodyIdentifiersDlg.HideOtherProjectsCheckBoxChange(Sender: TObject);
987 begin
988 if FItems=nil then exit;
989 IdleConnected:=true;
990 end;
991
992 procedure TCodyIdentifiersDlg.ItemsListBoxClick(Sender: TObject);
993 begin
994 if FItems=nil then exit;
995
996 end;
997
998 procedure TCodyIdentifiersDlg.ItemsListBoxSelectionChange(Sender: TObject;
999 User: boolean);
1000 begin
1001 if FItems=nil then exit;
1002 UpdateIdentifierInfo;
1003 end;
1004
1005 procedure TCodyIdentifiersDlg.OnIdle(Sender: TObject; var Done: Boolean);
1006 begin
1007 if not CodyUnitDictionary.Loaded then begin
1008 CodyUnitDictionary.Load;
1009 UpdateGeneralInfo;
1010 UpdateItemsList;
1011 end;
1012 UpdateItemsListIfFilterChanged;
1013 IdleConnected:=false;
1014 end;
1015
1016 procedure TCodyIdentifiersDlg.PopupMenu1Popup(Sender: TObject);
1017 var
1018 Identifier: string;
1019 UnitFilename: string;
1020 GroupName: string;
1021 GroupFilename: string;
1022 begin
1023 if FindSelectedItem(Identifier, UnitFilename, GroupName, GroupFilename) then
1024 begin
1025 UseMenuItem.Caption:='Use '+Identifier;
1026 UseMenuItem.Enabled:=true;
1027 JumpMenuItem.Caption:='Jump to '+Identifier;
1028 JumpMenuItem.Enabled:=true;
1029 DeleteUnitMenuItem.Caption:='Delete unit '+ExtractFilename(UnitFilename);
1030 DeleteUnitMenuItem.Enabled:=true;
1031 DeletePackageMenuItem.Caption:='Delete package '+ExtractFilename(GroupFilename);
1032 DeletePackageMenuItem.Enabled:=true;
1033 end else begin
1034 UseMenuItem.Enabled:=false;
1035 JumpMenuItem.Enabled:=false;
1036 DeleteUnitMenuItem.Enabled:=false;
1037 DeletePackageMenuItem.Enabled:=false;
1038 end;
1039 end;
1040
1041 procedure TCodyIdentifiersDlg.StartsRadioButtonClick(Sender: TObject);
1042 begin
1043 StartsRadioButton.Checked:=not ContainsRadioButton.Checked;
1044 IdleConnected:=true;
1045 end;
1046
1047 procedure TCodyIdentifiersDlg.SetIdleConnected(AValue: boolean);
1048 begin
1049 if FIdleConnected=AValue then Exit;
1050 FIdleConnected:=AValue;
1051 if Application=nil then exit;
1052 if IdleConnected then
1053 Application.AddOnIdleHandler(@OnIdle)
1054 else
1055 Application.RemoveOnIdleHandler(@OnIdle);
1056 end;
1057
1058 procedure TCodyIdentifiersDlg.SetDlgAction(NewAction: TCodyIdentifierDlgAction);
1059 begin
1060 FDlgAction:=NewAction;
1061 if FindSelectedItem(NewIdentifier, NewUnitFilename, NewGroupName,
1062 NewGroupFilename)
1063 then
1064 ModalResult:=mrOk
1065 else
1066 ModalResult:=mrNone;
1067 end;
1068
1069 procedure TCodyIdentifiersDlg.SetMaxItems(AValue: integer);
1070 begin
1071 if FMaxItems=AValue then Exit;
1072 FMaxItems:=AValue;
1073 UpdateItemsList;
1074 end;
1075
1076 procedure TCodyIdentifiersDlg.UpdateItemsList;
1077 var
1078 FilterP: PChar;
1079 Found: Integer;
1080 UnitSet: TFPCUnitSetCache;
1081 FPCSrcDir: String;
1082 CfgCache: TPCTargetConfigCache;
1083
1084 procedure AddItems(AddExactMatches: boolean);
1085 var
1086 FPCSrcFilename: String;
1087 Dir, aFilename: String;
1088 Group: TUDUnitGroup;
1089 GroupNode: TAVLTreeNode;
1090 Item: TUDIdentifier;
1091 Node: TAVLTreeNode;
1092 begin
1093 Node:=CodyUnitDictionary.Identifiers.FindLowest;
1094 //debugln(['TCodyIdentifiersDlg.UpdateItemsList Filter="',FLastFilter,'" Count=',CodyUnitDictionary.Identifiers.Count]);
1095 while Node<>nil do begin
1096 Item:=TUDIdentifier(Node.Data);
1097 Node:=CodyUnitDictionary.Identifiers.FindSuccessor(Node);
1098 if CompareIdentifiers(FilterP,PChar(Pointer(Item.Name)))=0 then begin
1099 // exact match
1100 if not AddExactMatches then continue;
1101 end else begin
1102 // not exact
1103 if AddExactMatches then continue;
1104 case FLastFilterType of
1105 cifStartsWith:
1106 if not ComparePrefixIdent(FilterP,PChar(Pointer(Item.Name))) then continue;
1107 cifContains:
1108 if IdentifierPos(FilterP,PChar(Pointer(Item.Name)))<0 then continue;
1109 end;
1110 end;
1111 if Found>MaxItems then begin
1112 inc(Found); // only count, do not check
1113 continue;
1114 end;
1115 GroupNode:=Item.DUnit.Groups.FindLowest;
1116 while GroupNode<>nil do begin
1117 Group:=TUDUnitGroup(GroupNode.Data);
1118 GroupNode:=Item.DUnit.Groups.FindSuccessor(GroupNode);
1119 if not FilenameIsAbsolute(Item.DUnit.Filename) then continue;
1120 if Group.Name='' then begin
1121 // it's a unit without package
1122 if FLastHideOtherProjects then begin
1123 // check if unit is in unit path of current owner
1124 if CurUnitPath='' then continue;
1125 Dir:=ExtractFilePath(Item.DUnit.Filename);
1126 if (Dir<>'')
1127 and (FindPathInSearchPath(PChar(Dir),length(Dir),
1128 PChar(CurUnitPath),length(CurUnitPath))=nil)
1129 then continue;
1130 end;
1131 end else if Group.Name=PackageNameFPCSrcDir then begin
1132 // it's a FPC source directory
1133 // => check if it is the current one
1134 Dir:=ChompPathDelim(ExtractFilePath(Group.Filename));
1135 if CompareFilenames(Dir,FPCSrcDir)<>0 then continue;
1136 // some units have multiple sources in FPC => check target platform
1137 if UnitSet<>nil then begin
1138 FPCSrcFilename:=UnitSet.GetUnitSrcFile(Item.DUnit.Name);
1139 if (FPCSrcFilename<>'')
1140 and (CompareFilenames(FPCSrcFilename,Item.DUnit.Filename)<>0)
1141 then continue; // this is not the source for this target platform
1142 if FLastHideOtherProjects then begin
1143 // Note: some units do no exists on all targets (e.g. windows.pp)
1144 if CfgCache.Units[Item.DUnit.Name]='' then
1145 continue; // the unit has no ppu file
1146 end;
1147 end;
1148 end else if Group.Name=PackageNameDefault then begin
1149 // unit was in default unit path
1150 // => check if this is still the case
1151 if CfgCache<>nil then begin
1152 aFilename:=CfgCache.Units[Item.DUnit.Name];
1153 if aFilename='' then
1154 continue; // the unit is not in current default unit path
1155 if CompareFilenames(aFilename,Item.DUnit.Filename)<>0 then
1156 continue; // this is another unit (e.g. from another compiler target)
1157 end;
1158 end else if FileExistsCached(Group.Filename) then begin
1159 // lpk exists
1160 end else begin
1161 // lpk does not exist any more
1162 CodyUnitDictionary.CheckFileAsync(Group.Filename);
1163 end;
1164 if FileExistsCached(Item.DUnit.Filename) then begin
1165 inc(Found);
1166 if Found<MaxItems then begin
1167 FItems.Add(TCodyIdentifier.Create(Item.Name,
1168 Item.DUnit.Name,Item.DUnit.Filename,
1169 Group.Name,Group.Filename,AddExactMatches));
1170 end;
1171 end else begin
1172 // unit does not exist any more
1173 CodyUnitDictionary.CheckFileAsync(Item.DUnit.Filename);
1174 end;
1175 end;
1176 end;
1177 end;
1178
1179 var
1180 sl: TStringList;
1181 i: Integer;
1182 Item: TCodyIdentifier;
1183 s: String;
1184 begin
1185 if not CodyUnitDictionary.Loaded then exit;
1186 FLastFilter:=GetFilterEditText;
1187 FilterP:=PChar(FLastFilter);
1188 FLastHideOtherProjects:=HideOtherProjectsCheckBox.Checked;
1189 FLastFilterType:=GetFilterType;
1190 UpdateCurOwnerOfUnit;
1191
1192 FItems.Clear;
1193 sl:=TStringList.Create;
1194 try
1195 Found:=0;
1196 UnitSet:=CodeToolBoss.GetUnitSetForDirectory('');
1197 FPCSrcDir:='';
1198 if (UnitSet<>nil) then begin
1199 FPCSrcDir:=ChompPathDelim(UnitSet.FPCSourceDirectory);
1200 CfgCache:=UnitSet.GetConfigCache(false);
1201 end;
1202 AddItems(true);
1203 AddItems(false);
1204
1205 SortItems;
1206
1207 for i:=0 to FItems.Count-1 do begin
1208 Item:=TCodyIdentifier(FItems[i]);
1209 s:=Item.Identifier+' in '+Item.Unit_Name;
1210 if Item.GroupName<>'' then begin
1211 if Item.GroupName=PackageNameDefault then
1212 s:=s+' in compiler unit path'
1213 else
1214 s:=s+' of '+Item.GroupName;
1215 end;
1216 sl.Add(s);
1217 end;
1218 if Found>sl.Count then
1219 sl.Add(Format(crsAndMoreIdentifiers, [IntToStr(Found-sl.Count)]));
1220
1221 ItemsListBox.Items.Assign(sl);
1222 if Found>0 then
1223 ItemsListBox.ItemIndex:=0;
1224 UpdateIdentifierInfo;
1225 finally
1226 sl.Free;
1227 end;
1228 end;
1229
1230 procedure TCodyIdentifiersDlg.UpdateItemsListIfFilterChanged;
1231 begin
1232 if (FLastFilter<>GetFilterEditText)
1233 or (FLastHideOtherProjects<>HideOtherProjectsCheckBox.Checked)
1234 or (FLastFilterType<>GetFilterType) then
1235 UpdateItemsList;
1236 end;
1237
1238 procedure TCodyIdentifiersDlg.SortItems;
1239 var
1240 i: Integer;
1241 Item: TCodyIdentifier;
1242 DepOwner: TObject;
1243 BaseDir: String;
1244 Dir: String;
1245 CurUnit: TUDUnit;
1246 begin
1247 BaseDir:=ExtractFilePath(CurMainFilename);
1248 for i:=0 to FItems.Count-1 do begin
1249 Item:=TCodyIdentifier(FItems[i]);
1250 Item.DirectUnit:=false;
1251 Item.UseCount:=0;
1252 CurUnit:=CodyUnitDictionary.FindUnitWithFilename(Item.UnitFile);
1253 if CurUnit<>nil then
1254 Item.UseCount:=CurUnit.UseCount;
1255 Item.PathDistance:=length(CreateRelativePath(ExtractFilePath(Item.UnitFile),BaseDir));
1256 Dir:=ChompPathDelim(ExtractFilePath(Item.UnitFile));
1257 if (not FilenameIsAbsolute(Item.UnitFile)) or (Dir='') then begin
1258 // new unit is always very near
1259 Item.DirectUnit:=true;
1260 continue;
1261 end;
1262 if (CurUnitPath<>'')
1263 and (FindPathInSearchPath(PChar(Dir),length(Dir),
1264 PChar(CurUnitPath),length(CurUnitPath))<>nil)
1265 then begin
1266 // unit is in search path of current unit
1267 Item.DirectUnit:=true;
1268 continue;
1269 end;
1270 if Item.GroupName='' then
1271 continue; // other project is always far away
1272 if Item.GroupName=PackageNameFPCSrcDir then
1273 continue; // FPC unit
1274 if Item.GroupName=PackageNameDefault then
1275 continue; // FPC unit
1276 if CurOwner=nil then continue;
1277 // package unit
1278 Item.InUsedPackage:=PackageEditingInterface.IsOwnerDependingOnPkg(CurOwner,
1279 Item.GroupName,DepOwner);
1280 end;
1281 FItems.Sort(@CompareCodyIdentifiersAlphaScopeUse);
1282 end;
1283
1284 procedure TCodyIdentifiersDlg.UpdateIdentifierInfo;
1285 var
1286 Identifier: string;
1287 UnitFilename: string;
1288 GroupName, GroupFilename: string;
1289 begin
1290 if FindSelectedItem(Identifier, UnitFilename, GroupName, GroupFilename) then begin
1291 if GroupFilename<>'' then
1292 UnitFilename:=CreateRelativePath(UnitFilename,ExtractFilePath(GroupFilename));
1293 UnitLabel.Caption:=Format(crsUnit2, [UnitFilename]);
1294 PackageLabel.Caption:=Format(crsPackage2, [GroupFilename]);
1295 ButtonPanel1.OKButton.Enabled:=true;
1296 end else begin
1297 UnitLabel.Caption:= Format(crsUnit2, [crsNoneSelected]);
1298 PackageLabel.Caption:= Format(crsPackage2, [crsNoneSelected]);
1299 ButtonPanel1.OKButton.Enabled:=false;
1300 end;
1301 end;
1302
1303 procedure TCodyIdentifiersDlg.UpdateGeneralInfo;
1304 var
1305 s: String;
1306 begin
1307 s:=Format(crsPackagesUnitsIdentifiersFile,
1308 [IntToStr(CodyUnitDictionary.UnitGroupsByFilename.Count),
1309 IntToStr(CodyUnitDictionary.UnitsByFilename.Count),
1310 IntToStr(CodyUnitDictionary.Identifiers.Count),
1311 LineEnding,
1312 CodyUnitDictionary.GetFilename]);
1313 if CodyUnitDictionary.LoadSaveError<>'' then
1314 s:=s+LineEnding+Format(crsError, [CodyUnitDictionary.LoadSaveError]);
1315 InfoLabel.Caption:=s;
1316 end;
1317
GetFilterEditTextnull1318 function TCodyIdentifiersDlg.GetFilterEditText: string;
1319 begin
1320 Result:=FilterEdit.Text;
1321 end;
1322
FindSelectedIdentifiernull1323 function TCodyIdentifiersDlg.FindSelectedIdentifier: TCodyIdentifier;
1324 var
1325 i: Integer;
1326 begin
1327 Result:=nil;
1328 if FItems=nil then exit;
1329 i:=ItemsListBox.ItemIndex;
1330 if (i<0) or (i>=FItems.Count) then exit;
1331 Result:=TCodyIdentifier(FItems[i]);
1332 end;
1333
FindSelectedItemnull1334 function TCodyIdentifiersDlg.FindSelectedItem(out Identifier, UnitFilename,
1335 GroupName, GroupFilename: string): boolean;
1336 var
1337 Item: TCodyIdentifier;
1338 begin
1339 Result:=false;
1340 Identifier:='';
1341 UnitFilename:='';
1342 GroupName:='';
1343 GroupFilename:='';
1344 Item:=FindSelectedIdentifier;
1345 if Item=nil then exit;
1346 Identifier:=Item.Identifier;
1347 UnitFilename:=Item.UnitFile;
1348 GroupName:=Item.GroupName;
1349 GroupFilename:=Item.GroupFile;
1350 //debugln(['TCodyIdentifiersDlg.FindSelectedItem ',Identifier,' Unit=',UnitFilename,' Pkg=',GroupFilename]);
1351 Result:=true;
1352 end;
1353
Initnull1354 function TCodyIdentifiersDlg.Init: boolean;
1355 var
1356 ErrorHandled: boolean;
1357 Line: String;
1358 ImplNode: TCodeTreeNode;
1359 begin
1360 Result:=true;
1361 CurInitError:=ParseTilCursor(CurTool, CurCleanPos, CurNode, ErrorHandled, false, @CurCodePos);
1362
1363 CurIdentifier:='';
1364 CurIdentStart:=0;
1365 CurIdentEnd:=0;
1366 if (CurCodePos.Code<>nil) then begin
1367 Line:=CurCodePos.Code.GetLine(CurCodePos.Y-1,false);
1368 GetIdentStartEndAtPosition(Line,CurCodePos.X,CurIdentStart,CurIdentEnd);
1369 if CurIdentStart<CurIdentEnd then
1370 CurIdentifier:=copy(Line,CurIdentStart,CurIdentEnd-CurIdentStart);
1371 end;
1372 CurInImplementation:=false;
1373 if (CurNode<>nil) then begin
1374 ImplNode:=CurTool.FindImplementationNode;
1375 if (ImplNode<>nil) and (ImplNode.StartPos<=CurNode.StartPos)
1376 then
1377 CurInImplementation:=true;
1378 end;
1379 AddToImplementationUsesCheckBox.Enabled:=CurInImplementation;
1380 AddToImplementationUsesCheckBox.Checked:=
1381 CodyOptions.PreferImplementationUsesSection;
1382
1383 CurSrcEdit:=SourceEditorManagerIntf.ActiveEditor;
1384 if CurTool<>nil then begin
1385 CurMainFilename:=CurTool.MainFilename;
1386 CurMainCode:=TCodeBuffer(CurTool.Scanner.MainCode);
1387 end else if CurSrcEdit<>nil then begin
1388 CurMainFilename:=CurSrcEdit.FileName;
1389 CurMainCode:=TCodeBuffer(CurSrcEdit.CodeToolsBuffer);
1390 end else begin
1391 CurMainFilename:='';
1392 CurMainCode:=nil;
1393 end;
1394
1395 UpdateCurOwnerOfUnit;
1396 UpdateGeneralInfo;
1397 FLastFilter:='...'; // force one update
1398 if CurIdentifier<>'' then
1399 FilterEdit.Text:=CurIdentifier;
1400 IdleConnected:=true;
1401 end;
1402
1403 procedure TCodyIdentifiersDlg.UseIdentifier;
1404 var
1405 UnitSet: TFPCUnitSetCache;
1406 NewUnitInPath: Boolean;
1407 FPCSrcFilename: String;
1408 CompOpts: TLazCompilerOptions;
1409 UnitPathAdd: String;
1410 Pkg: TIDEPackage;
1411 CurUnitName: String;
1412 NewUnitName: String;
1413 SameUnitName: boolean;
1414 PkgDependencyAdded: boolean;
1415 NewUnitCode: TCodeBuffer;
1416 NewCode: TCodeBuffer;
1417 NewX: integer;
1418 NewY: integer;
1419 NewTopLine: integer;
1420 CurUnit: TUDUnit;
1421 NewUnitDir: String;
1422
1423 function OpenDependency: boolean;
1424 // returns false to abort
1425 var
1426 DepOwner: TObject;
1427 begin
1428 debugln(['TCodyIdentifiersDlg.UseIdentifier not in unit path, loading package "'+NewGroupName+'", "'+NewGroupFilename+'" ...']);
1429 Result:=true;
1430 Pkg:=PackageEditingInterface.FindPackageWithName(NewGroupName);
1431 if (Pkg=nil) or (CompareFilenames(Pkg.Filename,NewGroupFilename)<>0) then
1432 begin
1433 if PackageEditingInterface.DoOpenPackageFile(NewGroupFilename,
1434 [pofDoNotOpenEditor],false)<>mrOK
1435 then begin
1436 debugln(['TCodyIdentifiersDlg.UseIdentifier: DoOpenPackageFile failed']);
1437 exit(false);
1438 end;
1439 Pkg:=PackageEditingInterface.FindPackageWithName(NewGroupName);
1440 if Pkg=nil then begin
1441 IDEMessageDialog(crsPackageNotFound,
1442 Format(crsPackageNotFoundItShouldBeIn, [NewGroupName, NewGroupFilename
1443 ]),
1444 mtError,[mbCancel]);
1445 exit(false);
1446 end;
1447 end;
1448 if PackageEditingInterface.IsOwnerDependingOnPkg(CurOwner,NewGroupName,DepOwner)
1449 then begin
1450 // already depending on package name
1451 PkgDependencyAdded:=true;
1452 debugln(['TCodyIdentifiersDlg.UseIdentifier owner is already using "'+NewGroupName+'"']);
1453 // ToDo: check version
1454 end;
1455 end;
1456
1457 function AddDependency: boolean;
1458 // returns false to abort
1459 var
1460 OwnerList: TFPList;
1461 AddResult: TModalResult;
1462 begin
1463 if PkgDependencyAdded then exit(true);
1464 PkgDependencyAdded:=true;
1465 // add dependency
1466 OwnerList:=TFPList.Create;
1467 try
1468 OwnerList.Add(CurOwner);
1469 AddResult:=PackageEditingInterface.AddDependencyToOwners(OwnerList,Pkg,true);
1470 if AddResult=mrIgnore then exit(true);
1471 if AddResult<>mrOk then begin
1472 debugln(['TCodyIdentifiersDlg.UseIdentifier checking via AddDependencyToOwners failed for new package "'+NewGroupName+'"']);
1473 exit(false);
1474 end;
1475 if PackageEditingInterface.AddDependencyToOwners(OwnerList,Pkg,false)<>mrOK
1476 then begin
1477 debugln(['TCodyIdentifiersDlg.UseIdentifier AddDependencyToOwners failed for new package "'+NewGroupName+'"']);
1478 exit(false);
1479 end;
1480 debugln(['TCodyIdentifiersDlg.UseIdentifier added dependency "'+NewGroupName+'"']);
1481 finally
1482 OwnerList.Free;
1483 end;
1484 Result:=true;
1485 end;
1486
1487 begin
1488 if CurSrcEdit=nil then exit;
1489
1490 UpdateCurOwnerOfUnit;
1491
1492 // do some sanity checks
1493 NewUnitInPath:=false;
1494 UnitPathAdd:=ChompPathDelim(
1495 CreateRelativePath(CurOwnerDir,
1496 ExtractFilePath(NewUnitFilename)));
1497 CurUnitName:=ExtractFileNameOnly(CurMainFilename);
1498 NewUnitName:=ExtractFileNameOnly(NewUnitFilename);
1499 FPCSrcFilename:='';
1500 Pkg:=nil;
1501 PkgDependencyAdded:=false;
1502
1503 debugln(['TCodyIdentifiersDlg.UseIdentifier CurUnitName="',CurUnitName,'" NewUnitName="',NewUnitName,'"']);
1504
1505 SameUnitName:=CompareDottedIdentifiers(PChar(CurUnitName),PChar(NewUnitName))=0;
1506 if SameUnitName and (CompareFilenames(CurMainFilename,NewUnitFilename)<>0)
1507 then begin
1508 // another unit with same name
1509 IDEMessageDialog(crsUnitNameClash,
1510 Format(crsTheTargetUnitHasTheSameNameAsTheCurrentUnitFreePas, [LineEnding]),
1511 mtError,[mbCancel]);
1512 exit;
1513 end;
1514
1515 debugln(['TCodyIdentifiersDlg.UseIdentifier CurMainFilename="',CurMainFilename,'" NewUnitFilename="',NewUnitFilename,'"']);
1516 if CompareFilenames(CurMainFilename,NewUnitFilename)=0 then begin
1517 // same file
1518 NewUnitInPath:=true;
1519 debugln(['TCodyIdentifiersDlg.UseIdentifier same unit CurMainFilename="',CurMainFilename,'" NewUnitFilename="',NewUnitFilename,'"']);
1520 end
1521 else if (CompareFilenames(ExtractFilePath(CurMainFilename),
1522 ExtractFilePath(NewUnitFilename))=0)
1523 then begin
1524 // same directory
1525 debugln(['TCodyIdentifiersDlg.UseIdentifier same directory CurMainFilename="',CurMainFilename,'" NewUnitFilename="',NewUnitFilename,'"']);
1526 NewUnitInPath:=true;
1527 end
1528 else if (CurUnitPath<>'')
1529 and FilenameIsAbsolute(NewUnitFilename) then begin
1530 NewUnitDir:=ExtractFilePath(NewUnitFilename);
1531 if (FindPathInSearchPath(PChar(NewUnitDir),length(NewUnitDir),
1532 PChar(CurUnitPath),length(CurUnitPath))<>nil)
1533 then begin
1534 // in unit search path
1535 debugln(['TCodyIdentifiersDlg.UseIdentifier in unit search path of owner NewUnitDir="',NewUnitDir,'" CurUnitPath="',CurUnitPath,'"']);
1536 NewUnitInPath:=true;
1537 end else
1538 debugln(['TCodyIdentifiersDlg.UseIdentifier not in unitpath: NewUnitDir="',NewUnitDir,'"']);
1539 end;
1540 if not NewUnitInPath then
1541 debugln(['TCodyIdentifiersDlg.UseIdentifier not in unit path: CurMainFilename="',CurMainFilename,'" NewUnitFilename="',NewUnitFilename,'" CurUnitPath="',CurUnitPath,'"']);
1542
1543 UnitSet:=CodeToolBoss.GetUnitSetForDirectory('');
1544 if not NewUnitInPath then begin
1545 // new unit is not in the projects/package unit path
1546 if NewGroupName=PackageNameFPCSrcDir then begin
1547 // new unit is a FPC unit
1548 debugln(['TCodyIdentifiersDlg.UseIdentifier in FPCSrcDir']);
1549 if UnitSet<>nil then
1550 FPCSrcFilename:=UnitSet.GetUnitSrcFile(ExtractFileNameOnly(NewUnitFilename));
1551 if FPCSrcFilename='' then begin
1552 // a FPC unit without a ppu file
1553 // => ask for confirmation
1554 if IDEQuestionDialog(crsFPCUnitWithoutPpu,
1555 crsThisUnitIsLocatedInTheFreePascalSourcesButNoPpuFil,
1556 mtConfirmation, [mrOk, crsExtendUnitPath, mrCancel])<> mrOk then exit;
1557 end else
1558 NewUnitInPath:=true;
1559 end else if NewGroupName=PackageNameDefault then begin
1560 // new unit is in default compiler unit path
1561 NewUnitInPath:=true;
1562 end else if NewGroupName<>'' then begin
1563 // new unit is part of a package
1564 debugln(['TCodyIdentifiersDlg.UseIdentifier unit is part of a package in "'+NewGroupFilename+'"']);
1565 Pkg:=PackageEditingInterface.FindPackageWithName(NewGroupName);
1566 if (Pkg<>nil) and (CompareFilenames(Pkg.Filename,NewGroupFilename)<>0) then
1567 begin
1568 if Pkg=CurOwner then begin
1569 IDEMessageDialog(crsImpossibleDependency,
1570 Format(crsTheUnitIsPartOfItCanNotUseAnotherPackageWithTheSam, [CurMainFilename,
1571 LineEnding, Pkg.Filename, LineEnding, LineEnding, NewGroupFilename]),
1572 mtError, [mbCancel]);
1573 exit;
1574 end;
1575 if IDEQuestionDialog(crsPackageWithSameName,
1576 Format(crsThereIsAlreadyAnotherPackageLoadedWithTheSameNameO, [LineEnding,
1577 Pkg.Filename, LineEnding, NewGroupFilename, LineEnding]),
1578 mtConfirmation, [mrCancel, crsBTNCancel,
1579 mrOk, crsCloseOtherPackageAndOpenNew]) <> mrOk
1580 then exit;
1581 end;
1582 end;
1583 if not NewUnitInPath then begin
1584 // new unit is a rogue unit (no package)
1585 debugln(['TCodyIdentifiersDlg.UseIdentifier unit is not in a package']);
1586 if UnitSet.GetUnitToSourceTree(false).Contains(NewUnitName) then
1587 NewUnitInPath:=true;
1588 end;
1589 end;
1590
1591 // open package to get the compiler settings to parse the unit
1592 if (CurOwner<>nil)
1593 and (not NewUnitInPath)
1594 and (NewGroupName<>'')
1595 and (NewGroupName<>PackageNameFPCSrcDir)
1596 and (NewGroupName<>PackageNameDefault) then begin
1597 if not OpenDependency then exit;
1598 end;
1599
1600 // check if target unit is readable
1601 NewUnitCode:=CodeToolBoss.LoadFile(NewUnitFilename,true,false);
1602 if NewUnitCode=nil then begin
1603 IDEMessageDialog(crsFileReadError,
1604 Format(crsUnableToReadFile, [NewUnitFilename]),
1605 mtError,[mbCancel]);
1606 exit;
1607 end;
1608
1609 // check if identifier still exist
1610 if not CodeToolBoss.FindDeclarationInInterface(NewUnitCode,NewIdentifier,
1611 NewCode, NewX, NewY, NewTopLine)
1612 then begin
1613 IDEMessageDialog(crsIdentifierNotFound,
1614 Format(crsIdentifierNotFoundInUnit, [NewIdentifier, NewUnitFilename]),
1615 mtError,[mbCancel]);
1616 exit;
1617 end;
1618
1619 CurSrcEdit.BeginUndoBlock{$IFDEF SynUndoDebugBeginEnd}('TCodyIdentifiersDlg.UseIdentifier'){$ENDIF};
1620 try
1621 // insert or replace identifier
1622 if (not CurSrcEdit.SelectionAvailable)
1623 and (CurIdentStart<CurIdentEnd) then
1624 CurSrcEdit.SelectText(CurCodePos.Y,CurIdentStart,CurCodePos.Y,CurIdentEnd);
1625 CurSrcEdit.Selection:=NewIdentifier;
1626
1627 debugln(['TCodyIdentifiersDlg.UseIdentifier CurOwner=',DbgSName(CurOwner),' ',NewUnitInPath]);
1628 if (CurOwner<>nil) and (not NewUnitInPath) then begin
1629 debugln(['TCodyIdentifiersDlg.UseIdentifier not in unit path, connecting pkg="',NewGroupName,'" ...']);
1630 if (NewGroupName<>'') then begin
1631 // add dependency
1632 if (NewGroupName<>PackageNameFPCSrcDir)
1633 and (NewGroupName<>PackageNameDefault)
1634 then
1635 if not AddDependency then exit;
1636 end else if FilenameIsAbsolute(NewUnitFilename)
1637 and FilenameIsAbsolute(CurMainFilename) then begin
1638 // extend unit path
1639 CompOpts:=GetCurOwnerCompilerOptions;
1640 if CompOpts<>nil then begin
1641 CompOpts.OtherUnitFiles:=CompOpts.OtherUnitFiles+';'+UnitPathAdd;
1642 end;
1643 end;
1644 end;
1645
1646 if not SameUnitName then
1647 AddToUsesSection(true);
1648 finally
1649 CurSrcEdit.EndUndoBlock{$IFDEF SynUndoDebugBeginEnd}('TCodyIdentifiersDlg.UseIdentifier'){$ENDIF};
1650 end;
1651
1652 CurUnit:=CodyUnitDictionary.FindUnitWithFilename(NewUnitFilename);
1653 if CurUnit<>nil then
1654 CodyUnitDictionary.IncreaseUnitUseCount(CurUnit);
1655 end;
1656
1657 procedure TCodyIdentifiersDlg.JumpToIdentifier;
1658 var
1659 NewUnitCode: TCodeBuffer;
1660 NewCode: TCodeBuffer;
1661 NewX: integer;
1662 NewY: integer;
1663 NewTopLine: integer;
1664 Pkg: TIDEPackage;
1665 begin
1666 if not FileExistsUTF8(NewUnitFilename) then begin
1667 IDEMessageDialog(crsFileNotFound,
1668 Format(crsFileDoesNotExistAnymore, [NewUnitFilename]),
1669 mtError,[mbCancel]);
1670 exit;
1671 end;
1672
1673 // open package to get proper settings
1674 if (NewGroupName<>'')
1675 and (NewGroupName<>PackageNameFPCSrcDir)
1676 and (NewGroupName<>PackageNameDefault) then begin
1677 Pkg:=PackageEditingInterface.FindPackageWithName(NewGroupName);
1678 if (Pkg=nil) or (CompareFilenames(Pkg.Filename,NewGroupFilename)<>0) then
1679 begin
1680 if PackageEditingInterface.DoOpenPackageFile(NewGroupFilename,
1681 [pofAddToRecent],true)=mrAbort
1682 then
1683 exit;
1684 end;
1685 end;
1686
1687 // load file
1688 NewUnitCode:=CodeToolBoss.LoadFile(NewUnitFilename,true,false);
1689 if NewUnitCode=nil then begin
1690 IDEMessageDialog(crsFileReadError,
1691 Format(crsUnableToReadFile, [NewUnitFilename]),
1692 mtError,[mbCancel]);
1693 exit;
1694 end;
1695
1696 if not CodeToolBoss.FindDeclarationInInterface(NewUnitCode,NewIdentifier,
1697 NewCode, NewX, NewY, NewTopLine)
1698 then begin
1699 IDEMessageDialog(crsIdentifierNotFound,
1700 Format(crsIdentifierNotFoundInUnit, [NewIdentifier, NewUnitFilename]),
1701 mtError,[mbCancel]);
1702 exit;
1703 end;
1704
1705 LazarusIDE.DoOpenFileAndJumpToPos(NewCode.Filename,Point(NewX,NewY),NewTopLine,
1706 -1,-1,[ofDoNotLoadResource]);
1707 end;
1708
OwnerToStringnull1709 function TCodyIdentifiersDlg.OwnerToString(AnOwner: TObject): string;
1710 begin
1711 Result:='nil';
1712 if AnOwner is TLazProject then
1713 Result:='project'
1714 else if AnOwner is TIDEPackage then
1715 Result:=TIDEPackage(AnOwner).Name;
1716 end;
1717
GetFilterTypenull1718 function TCodyIdentifiersDlg.GetFilterType: TCodyIdentifierFilter;
1719 begin
1720 if ContainsRadioButton.Checked then
1721 exit(cifContains)
1722 else
1723 exit(cifStartsWith);
1724 end;
1725
1726 procedure TCodyIdentifiersDlg.UpdateCurOwnerOfUnit;
1727
1728 procedure GetBest(OwnerList: TFPList);
1729 var
1730 i: Integer;
1731 begin
1732 if OwnerList=nil then exit;
1733 for i:=0 to OwnerList.Count-1 do begin
1734 if (TObject(OwnerList[i]) is TLazProject)
1735 or ((TObject(OwnerList[i]) is TIDEPackage) and (CurOwner=nil)) then
1736 CurOwner:=TObject(OwnerList[i]);
1737 end;
1738 OwnerList.Free;
1739 end;
1740
1741 var
1742 CompOpts: TLazCompilerOptions;
1743 begin
1744 CurOwner:=nil;
1745 CurUnitPath:='';
1746 CurOwnerDir:='';
1747 if CurMainFilename='' then exit;
1748 GetBest(PackageEditingInterface.GetOwnersOfUnit(CurMainFilename));
1749 if CurOwner=nil then
1750 GetBest(PackageEditingInterface.GetPossibleOwnersOfUnit(CurMainFilename,
1751 [piosfExcludeOwned,piosfIncludeSourceDirectories]));
1752 if CurOwner<>nil then begin
1753 CompOpts:=GetCurOwnerCompilerOptions;
1754 if CompOpts<>nil then
1755 CurUnitPath:=CompOpts.GetUnitPath(false);
1756 if CurOwner is TIDEProjPackBase then
1757 CurOwnerDir:= TIDEProjPackBase(CurOwner).Directory;
1758 end;
1759 end;
1760
1761 procedure TCodyIdentifiersDlg.AddToUsesSection(JumpToSrcError: boolean);
1762 var
1763 NewUnitCode: TCodeBuffer;
1764 NewUnitName: String;
1765 CurUnitName: String;
1766 UsesNode: TCodeTreeNode;
1767 begin
1768 if (CurTool=nil) or (NewUnitFilename='') then begin
1769 debugln(['TCodyIdentifiersDlg.AddToUsesSection failed: no tool']);
1770 exit;
1771 end;
1772 UpdateTool(JumpToSrcError);
1773 if (CurNode=nil) then begin
1774 debugln(['TCodyIdentifiersDlg.AddToUsesSection failed: no node']);
1775 exit;
1776 end;
1777
1778 // check if already in uses section
1779 NewUnitName:=ExtractFileNameOnly(NewUnitFilename);
1780 if CurTool.IsHiddenUsedUnit(PChar(NewUnitName)) then begin
1781 debugln(['TCodyIdentifiersDlg.AddToUsesSection "',NewUnitName,'" is hidden used unit']);
1782 exit;
1783 end;
1784 UsesNode:=CurTool.FindMainUsesNode;
1785 if (UsesNode<>nil) and (CurTool.FindNameInUsesSection(UsesNode,NewUnitName)<>nil)
1786 then begin
1787 debugln(['TCodyIdentifiersDlg.AddToUsesSection "',NewUnitName,'" is already used in main uses section']);
1788 exit;
1789 end;
1790 if CurInImplementation then begin
1791 UsesNode:=CurTool.FindImplementationUsesNode;
1792 if (UsesNode<>nil) and (CurTool.FindNameInUsesSection(UsesNode,NewUnitName)<>nil)
1793 then begin
1794 debugln(['TCodyIdentifiersDlg.AddToUsesSection "',NewUnitName,'" is already used in implementation uses section']);
1795 exit;
1796 end;
1797 end;
1798
1799 // get unit name
1800 NewUnitCode:=CodeToolBoss.LoadFile(NewUnitFilename,true,false);
1801 if NewUnitCode=nil then begin
1802 debugln(['TCodyIdentifiersDlg.AddToUsesSection failed: unable to load file "',NewUnitFilename,'"']);
1803 exit;
1804 end;
1805 NewUnitName:=CodeToolBoss.GetSourceName(NewUnitCode,false);
1806 if NewUnitName='' then
1807 NewUnitName:=ExtractFileNameOnly(NewUnitFilename);
1808 CurUnitName:=ExtractFileNameOnly(CurMainFilename);
1809 if CompareDottedIdentifiers(PChar(CurUnitName),PChar(NewUnitName))=0 then begin
1810 debugln(['TCodyIdentifiersDlg.AddToUsesSection same unit']);
1811 exit; // is the same unit
1812 end;
1813
1814 if (CurNode.Desc in [ctnUnit,ctnUsesSection]) then begin
1815 debugln(['TCodyIdentifiersDlg.AddToUsesSection identifier in uses section, not adding unit to uses section']);
1816 exit;
1817 end;
1818
1819 // add to uses section
1820 debugln(['TCodyIdentifiersDlg.AddToUsesSection adding to uses section']);
1821 if CurInImplementation and AddToImplementationUsesCheckBox.Checked then
1822 CodeToolBoss.AddUnitToImplementationUsesSection(CurMainCode,NewUnitName,'')
1823 else
1824 CodeToolBoss.AddUnitToMainUsesSection(CurMainCode,NewUnitName,'');
1825 if CodeToolBoss.ErrorMessage<>'' then
1826 LazarusIDE.DoJumpToCodeToolBossError;
1827 end;
1828
UpdateToolnull1829 function TCodyIdentifiersDlg.UpdateTool(JumpToSrcError: boolean): boolean;
1830 var
1831 Tool: TCodeTool;
1832 begin
1833 Result:=false;
1834 if (CurTool=nil) or (NewUnitFilename='') then exit;
1835 if not LazarusIDE.BeginCodeTools then exit;
1836 try
1837 CurTool.BuildTree(lsrEnd);
1838 except
1839 end;
1840 CurNode:=CurTool.FindDeepestNodeAtPos(CurCleanPos,false);
1841 if CurNode<>nil then
1842 Result:=true
1843 else if JumpToSrcError then begin
1844 CodeToolBoss.Explore(CurCodePos.Code,Tool,false);
1845 if CodeToolBoss.ErrorCode=nil then
1846 IDEMessageDialog(crsCaretOutsideOfCode, CurTool.CleanPosToStr(
1847 CurCleanPos, true),
1848 mtError,[mbOk])
1849 else
1850 LazarusIDE.DoJumpToCodeToolBossError;
1851 end;
1852 end;
1853
AddButtonnull1854 function TCodyIdentifiersDlg.AddButton: TBitBtn;
1855 begin
1856 Result := TBitBtn.Create(Self);
1857 Result.Align := alCustom;
1858 Result.Default := false;
1859 Result.Constraints.MinWidth:=25;
1860 Result.AutoSize := true;
1861 Result.Parent := ButtonPanel1;
1862 end;
1863
GetCurOwnerCompilerOptionsnull1864 function TCodyIdentifiersDlg.GetCurOwnerCompilerOptions: TLazCompilerOptions;
1865 begin
1866 if CurOwner is TLazProject then
1867 Result:=TLazProject(CurOwner).LazCompilerOptions
1868 else if CurOwner is TIDEPackage then
1869 Result:=TIDEPackage(CurOwner).LazCompilerOptions
1870 else
1871 Result:=nil;
1872 end;
1873
1874 finalization
1875 FreeAndNil(CodyUnitDictionary);
1876
1877 end.
1878
1879