1{ 2 /*************************************************************************** 3 ViewUnit_dlg.pp 4 --------------- 5 TViewUnit is the application dialog for displaying all units in a project. 6 It gets used for the "View Units", "View Forms" and "Remove from Project" 7 menu items. 8 9 10 Initial Revision : Sat Feb 19 17:42 CST 1999 11 12 13 ***************************************************************************/ 14 15 *************************************************************************** 16 * * 17 * This source is free software; you can redistribute it and/or modify * 18 * it under the terms of the GNU General Public License as published by * 19 * the Free Software Foundation; either version 2 of the License, or * 20 * (at your option) any later version. * 21 * * 22 * This code is distributed in the hope that it will be useful, but * 23 * WITHOUT ANY WARRANTY; without even the implied warranty of * 24 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * 25 * General Public License for more details. * 26 * * 27 * A copy of the GNU General Public License is available on the World * 28 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also * 29 * obtain it by writing to the Free Software Foundation, * 30 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * 31 * * 32 *************************************************************************** 33} 34unit ViewUnit_Dlg; 35 36{$mode objfpc}{$H+} 37 38{$I ide.inc} 39 40interface 41 42uses 43 SysUtils, Classes, Laz_AVL_Tree, 44 // LCL 45 LCLType, LCLIntf, 46 Controls, Forms, Buttons, StdCtrls, ExtCtrls, ButtonPanel, Menus, ComCtrls, 47 // LazUtils 48 LazSysUtils, LazFileUtils, LazFileCache, AvgLvlTree, 49 // Codetools 50 CodeToolManager, FileProcs, 51 // LazControls 52 ListFilterEdit, 53 // IdeIntf 54 IDEWindowIntf, IDEHelpIntf, IDEImagesIntf, 55 // IDE 56 LazarusIdeStrConsts, IDEProcs, CustomFormEditor, PackageDefs; 57 58type 59 TIDEProjectItem = ( 60 piNone, 61 piUnit, 62 piComponent, 63 piFrame 64 ); 65 66 { TViewUnitsEntry } 67 68 TViewUnitsEntry = class 69 public 70 Name: string; 71 ID: integer; 72 Selected: boolean; 73 Filename: string; 74 constructor Create(const AName, AFilename: string; AnID: integer; ASelected: boolean); 75 end; 76 77 { TViewUnitsEntryEnumerator } 78 79 TViewUnitsEntryEnumerator = class 80 private 81 FTree: TAVLTree; 82 FCurrent: TAVLTreeNode; 83 function GetCurrent: TViewUnitsEntry; 84 public 85 constructor Create(Tree: TAVLTree); 86 function MoveNext: boolean; 87 property Current: TViewUnitsEntry read GetCurrent; 88 end; 89 90 { TViewUnitEntries } 91 92 TViewUnitEntries = class 93 private 94 fItems: TStringToPointerTree; // tree of TViewUnitsEntry 95 public 96 constructor Create; 97 destructor Destroy; override; 98 procedure Clear; 99 function Add(AName, AFilename: string; AnID: integer; ASelected: boolean): TViewUnitsEntry; 100 function Find(const aName: string): TViewUnitsEntry; inline; 101 function Count: integer; inline; 102 function GetFiles: TStringList; 103 function GetNames: TStringList; 104 function GetEntries: TFPList; 105 function GetEnumerator: TViewUnitsEntryEnumerator; 106 end; 107 108 { TViewUnitDialog } 109 110 TViewUnitDialog = class(TForm) 111 BtnPanel: TPanel; 112 ButtonPanel: TButtonPanel; 113 DummySpeedButton: TSpeedButton; 114 FilterEdit: TListFilterEdit; 115 ListBox: TListBox; 116 mniMultiSelect: TMenuItem; 117 OptionsBitBtn: TSpeedButton; 118 popListBox: TPopupMenu; 119 ProgressBar1: TProgressBar; 120 RemoveBitBtn: TSpeedButton; 121 SortAlphabeticallySpeedButton: TSpeedButton; 122 procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction); 123 procedure FormCreate(Sender: TObject); 124 procedure FormDestroy(Sender: TObject); 125 procedure ListboxDrawItem({%H-}Control: TWinControl; Index: Integer; 126 ARect: TRect; {%H-}State: TOwnerDrawState); 127 procedure ListboxKeyPress(Sender: TObject; var Key: char); 128 procedure ListboxMeasureItem({%H-}Control: TWinControl; {%H-}Index: Integer; 129 var AHeight: Integer); 130 procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean); 131 procedure SortAlphabeticallySpeedButtonClick(Sender: TObject); 132 procedure OKButtonClick(Sender :TObject); 133 procedure HelpButtonClick(Sender: TObject); 134 procedure CancelButtonClick(Sender :TObject); 135 procedure MultiselectCheckBoxClick(Sender :TObject); 136 private 137 FIdleConnected: boolean; 138 FItemType: TIDEProjectItem; 139 FSortAlphabetically: boolean; 140 FImageIndex: Integer; 141 fStartFilename: string; 142 fSearchDirectories: TFilenameToStringTree; // queued directories to search 143 fSearchFiles: TFilenameToStringTree; // queued files to search 144 fFoundFiles: TFilenameToStringTree; // filename to caption 145 fEntries: TViewUnitEntries; 146 procedure SetIdleConnected(AValue: boolean); 147 procedure SetItemType(AValue: TIDEProjectItem); 148 procedure SetSortAlphabetically(const AValue: boolean); 149 procedure ShowEntries; 150 procedure UpdateEntries; 151 public 152 procedure Init(const aCaption: string; 153 EnableMultiSelect: Boolean; aItemType: TIDEProjectItem; 154 TheEntries: TViewUnitEntries; aStartFilename: string = ''); 155 property SortAlphabetically: boolean read FSortAlphabetically write SetSortAlphabetically; 156 property ItemType: TIDEProjectItem read FItemType write SetItemType; 157 property IdleConnected: boolean read FIdleConnected write SetIdleConnected; 158 end; 159 160// Entries is a list of TViewUnitsEntry(s) 161function ShowViewUnitsDlg(Entries: TViewUnitEntries; CheckMultiSelect: Boolean; 162 const aCaption: string; ItemType: TIDEProjectItem; 163 StartFilename: string = '' // if StartFilename is given the Entries are automatically updated 164 ): TModalResult; 165 166implementation 167 168{$R *.lfm} 169 170function ShowViewUnitsDlg(Entries: TViewUnitEntries; CheckMultiSelect: Boolean; 171 const aCaption: string; ItemType: TIDEProjectItem; StartFilename: string): TModalResult; 172var 173 ViewUnitDialog: TViewUnitDialog; 174begin 175 ViewUnitDialog:=TViewUnitDialog.Create(nil); 176 try 177 ViewUnitDialog.Init(aCaption,CheckMultiSelect,ItemType,Entries,StartFilename); 178 // Show the dialog 179 Result:=ViewUnitDialog.ShowModal; 180 finally 181 ViewUnitDialog.Free; 182 end; 183end; 184 185{ TViewUnitsEntryEnumerator } 186 187function TViewUnitsEntryEnumerator.GetCurrent: TViewUnitsEntry; 188begin 189 if (FCurrent<>nil) and (FCurrent.Data<>nil) then 190 Result:=TViewUnitsEntry(PStringToPointerTreeItem(FCurrent.Data)^.Value) 191 else 192 Result:=nil; 193end; 194 195constructor TViewUnitsEntryEnumerator.Create(Tree: TAVLTree); 196begin 197 FTree:=Tree; 198end; 199 200function TViewUnitsEntryEnumerator.MoveNext: boolean; 201begin 202 if FCurrent=nil then 203 FCurrent:=FTree.FindLowest 204 else 205 FCurrent:=FTree.FindSuccessor(FCurrent); 206 Result:=FCurrent<>nil; 207end; 208 209{ TViewUnitEntries } 210 211// inline 212function TViewUnitEntries.Count: integer; 213begin 214 Result:=fItems.Count; 215end; 216 217// inline 218function TViewUnitEntries.Find(const aName: string): TViewUnitsEntry; 219begin 220 Result:=TViewUnitsEntry(fItems[aName]); 221end; 222 223function TViewUnitEntries.GetFiles: TStringList; 224var 225 S2PItem: PStringToPointerTreeItem; 226begin 227 Result:=TStringList.Create; 228 for S2PItem in fItems do 229 Result.Add(TViewUnitsEntry(S2PItem^.Value).Filename); 230end; 231 232function TViewUnitEntries.GetNames: TStringList; 233var 234 S2PItem: PStringToPointerTreeItem; 235begin 236 Result:=TStringList.Create; 237 for S2PItem in fItems do 238 Result.Add(TViewUnitsEntry(S2PItem^.Value).Name); 239end; 240 241function TViewUnitEntries.GetEntries: TFPList; 242var 243 S2PItem: PStringToPointerTreeItem; 244begin 245 Result:=TFPList.Create; 246 for S2PItem in fItems do 247 Result.Add(TViewUnitsEntry(S2PItem^.Value)); 248end; 249 250function TViewUnitEntries.GetEnumerator: TViewUnitsEntryEnumerator; 251begin 252 Result:=TViewUnitsEntryEnumerator.Create(fItems.Tree); 253end; 254 255constructor TViewUnitEntries.Create; 256begin 257 fItems:=TStringToPointerTree.create(false); 258end; 259 260destructor TViewUnitEntries.Destroy; 261begin 262 Clear; 263 FreeAndNil(fItems); 264 inherited Destroy; 265end; 266 267procedure TViewUnitEntries.Clear; 268var 269 S2PItem: PStringToPointerTreeItem; 270begin 271 for S2PItem in fItems do 272 begin 273 TViewUnitsEntry(S2PItem^.Value).Free; 274 S2PItem^.Value:=nil; 275 end; 276 fItems.Clear; 277end; 278 279function TViewUnitEntries.Add(AName, AFilename: string; AnID: integer; 280 ASelected: boolean): TViewUnitsEntry; 281var 282 i: Integer; 283begin 284 if Find(AName)<>nil then begin 285 i:=2; 286 while Find(AName+'('+IntToStr(i)+')')<>nil do 287 inc(i); 288 AName:=AName+'('+IntToStr(i)+')'; 289 end; 290 Result:=TViewUnitsEntry.Create(AName,AFilename,AnID,ASelected); 291 fItems[AName]:=Result; 292end; 293 294{ TViewUnitsEntry } 295 296constructor TViewUnitsEntry.Create(const AName, AFilename: string; 297 AnID: integer; ASelected: boolean); 298begin 299 inherited Create; 300 Name := AName; 301 ID := AnID; 302 Selected := ASelected; 303 Filename := AFilename; 304end; 305 306{ TViewUnitDialog } 307 308procedure TViewUnitDialog.FormCreate(Sender: TObject); 309begin 310 IDEDialogLayoutList.ApplyLayout(Self,450,300); 311 fSearchDirectories:=TFilenameToStringTree.Create(false); 312 fSearchFiles:=TFilenameToStringTree.Create(false); 313 fFoundFiles:=TFilenameToStringTree.Create(false); 314 315 mniMultiSelect.Caption := dlgMultiSelect; 316 ButtonPanel.OKButton.Caption:=lisMenuOk; 317 ButtonPanel.HelpButton.Caption:=lisMenuHelp; 318 ButtonPanel.CancelButton.Caption:=lisCancel; 319 SortAlphabeticallySpeedButton.Hint:=lisPESortFilesAlphabetically; 320 IDEImages.AssignImage(SortAlphabeticallySpeedButton, 'pkg_sortalphabetically'); 321end; 322 323procedure TViewUnitDialog.FormDestroy(Sender: TObject); 324begin 325 FreeAndNil(fSearchDirectories); 326 FreeAndNil(fSearchFiles); 327 FreeAndNil(fFoundFiles); 328 IdleConnected:=false; 329end; 330 331procedure TViewUnitDialog.FormClose(Sender: TObject; var CloseAction: TCloseAction); 332begin 333 IDEDialogLayoutList.SaveLayout(Self); 334end; 335 336procedure TViewUnitDialog.Init(const aCaption: string; 337 EnableMultiSelect: Boolean; aItemType: TIDEProjectItem; 338 TheEntries: TViewUnitEntries; aStartFilename: string); 339var 340 SearchPath: String; 341 p: Integer; 342 Dir: String; 343begin 344 Caption:=aCaption; 345 ItemType:=aItemType; 346 fEntries:=TheEntries; 347 mniMultiselect.Enabled := EnableMultiSelect; 348 mniMultiselect.Checked := EnableMultiSelect; 349 ListBox.MultiSelect := mniMultiselect.Enabled; 350 ShowEntries; 351 352 if aStartFilename<>'' then begin 353 // init search for units 354 // -> get unit search path and fill fSearchDirectories 355 fStartFilename:=TrimFilename(aStartFilename); 356 SearchPath:=CodeToolBoss.GetCompleteSrcPathForDirectory(ExtractFilePath(fStartFilename)); 357 p:=1; 358 while p<=length(SearchPath) do begin 359 Dir:=GetNextDirectoryInSearchPath(SearchPath,p); 360 if Dir<>'' then 361 fSearchDirectories[Dir]:=''; 362 end; 363 IdleConnected:=fSearchDirectories.Count>0; 364 end; 365end; 366 367procedure TViewUnitDialog.SortAlphabeticallySpeedButtonClick(Sender: TObject); 368begin 369 SortAlphabetically:=SortAlphabeticallySpeedButton.Down; 370end; 371 372procedure TViewUnitDialog.ListboxDrawItem(Control: TWinControl; Index: Integer; 373 ARect: TRect; State: TOwnerDrawState); 374var 375 aTop: Integer; 376begin 377 if Index < 0 then Exit; 378 with ListBox do 379 begin 380 Canvas.FillRect(ARect); 381 aTop := (ARect.Bottom + ARect.Top - IDEImages.Images_16.Height) div 2; 382 IDEImages.Images_16.Draw(Canvas, 1, aTop, FImageIndex); 383 aTop := (ARect.Bottom + ARect.Top - Canvas.TextHeight('Šj9')) div 2; 384 Canvas.TextRect(ARect, ARect.Left + IDEImages.Images_16.Width + Scale96ToFont(4), aTop, Items[Index]); 385 end; 386end; 387 388procedure TViewUnitDialog.OnIdle(Sender: TObject; var Done: Boolean); 389 390 procedure CheckFile(aFilename: string); 391 var 392 CompClass: TPFComponentBaseClass; 393 begin 394 //debugln(['CheckFile ',aFilename]); 395 case ItemType of 396 piUnit: 397 begin 398 end; 399 piComponent: 400 begin 401 CompClass:=FindLFMBaseClass(aFilename); 402 if CompClass=pfcbcNone then exit; 403 end; 404 piFrame: 405 begin 406 CompClass:=FindLFMBaseClass(aFilename); 407 if CompClass<>pfcbcFrame then exit; 408 end; 409 end; 410 fFoundFiles[aFilename]:=ExtractFileName(aFilename); 411 end; 412 413 procedure CheckDirectory(aDirectory: string); 414 var 415 Files: TStrings; 416 i: Integer; 417 aFilename: String; 418 begin 419 if not FilenameIsAbsolute(aDirectory) then exit; 420 aDirectory:=AppendPathDelim(aDirectory); 421 //DebugLn(['CheckDirectory ',aDirectory]); 422 Files:=nil; 423 try 424 CodeToolBoss.DirectoryCachePool.GetListing(aDirectory,Files,false); 425 if Files=nil then exit; 426 for i:=0 to Files.Count-1 do begin 427 aFilename:=Files[i]; 428 if not FilenameIsPascalUnit(aFilename) then continue; 429 aFilename:=aDirectory+aFilename; 430 if (ItemType in [piComponent,piFrame]) 431 and (not FileExistsCached(ChangeFileExt(aFilename,'.lfm'))) then 432 continue; 433 fSearchFiles[aFilename]:=''; 434 end; 435 finally 436 Files.Free; 437 end; 438 end; 439 440var 441 AVLNode: TAVLTreeNode; 442 StartTime: int64; 443 aFilename: String; 444begin 445 StartTime:=int64(GetTickCount64); 446 while Abs(StartTime-int64(GetTickCount64))<100 do begin 447 AVLNode:=fSearchFiles.Tree.FindLowest; 448 if AVLNode<>nil then begin 449 aFilename:=fSearchFiles.GetNodeData(AVLNode)^.Name; 450 fSearchFiles.Remove(aFilename); 451 CheckFile(aFilename); 452 end else begin 453 AVLNode:=fSearchDirectories.Tree.FindLowest; 454 if AVLNode<>nil then begin 455 aFilename:=fSearchDirectories.GetNodeData(AVLNode)^.Name; 456 fSearchDirectories.Remove(aFilename); 457 CheckDirectory(aFilename); 458 end else begin 459 // update entries from fFoundFiles 460 UpdateEntries; 461 IdleConnected:=false; 462 exit; 463 end; 464 end; 465 end; 466end; 467 468procedure TViewUnitDialog.OKButtonClick(Sender: TObject); 469var 470 S2PItem: PStringToPointerTreeItem; 471 Entry: TViewUnitsEntry; 472Begin 473 FilterEdit.StoreSelection; 474 for S2PItem in fEntries.fItems do begin 475 Entry:=TViewUnitsEntry(S2PItem^.Value); 476 Entry.Selected:=FilterEdit.SelectionList.IndexOf(Entry.Name)>-1; 477 if Entry.Selected then 478 ModalResult := mrOK; 479 end; 480End; 481 482procedure TViewUnitDialog.HelpButtonClick(Sender: TObject); 483begin 484 LazarusHelp.ShowHelpForIDEControl(Self); 485end; 486 487procedure TViewUnitDialog.CancelButtonClick(Sender: TObject); 488Begin 489 ModalResult := mrCancel; 490end; 491 492procedure TViewUnitDialog.ListboxKeyPress(Sender: TObject; var Key: char); 493begin 494 if Key = Char(VK_RETURN) then 495 OKButtonClick(nil); 496end; 497 498procedure TViewUnitDialog.ListboxMeasureItem(Control: TWinControl; 499 Index: Integer; var AHeight: Integer); 500begin 501 if AHeight <= IDEImages.Images_16.Height then 502 AHeight := IDEImages.Images_16.Height + 2; 503end; 504 505procedure TViewUnitDialog.MultiselectCheckBoxClick(Sender :TObject); 506begin 507 ListBox.Multiselect := mniMultiSelect.Checked; 508end; 509 510procedure TViewUnitDialog.SetSortAlphabetically(const AValue: boolean); 511begin 512 if FSortAlphabetically=AValue then exit; 513 FSortAlphabetically:=AValue; 514 SortAlphabeticallySpeedButton.Down:=SortAlphabetically; 515 FilterEdit.SortData:=SortAlphabetically; 516 FilterEdit.InvalidateFilter; 517end; 518 519procedure TViewUnitDialog.ShowEntries; 520var 521 UEntry: TViewUnitsEntry; 522begin 523 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TViewUnitDialog.ShowEntries'){$ENDIF}; 524 try 525 // Data items 526 FilterEdit.Items.Clear; 527 for UEntry in fEntries do 528 FilterEdit.Items.Add(UEntry.Name); 529 FilterEdit.InvalidateFilter; 530 finally 531 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TViewUnitDialog.ShowEntries'){$ENDIF}; 532 end; 533end; 534 535procedure TViewUnitDialog.UpdateEntries; 536var 537 F2SItem: PStringToStringItem; 538begin 539 fEntries.Clear; 540 for F2SItem in fFoundFiles do 541 fEntries.Add(F2SItem^.Value,F2SItem^.Name,-1,false); 542 ShowEntries; 543end; 544 545procedure TViewUnitDialog.SetItemType(AValue: TIDEProjectItem); 546begin 547 if FItemType=AValue then Exit; 548 FItemType:=AValue; 549 case ItemType of 550 piComponent: FImageIndex := IDEImages.LoadImage('item_form'); 551 piFrame: FImageIndex := IDEImages.LoadImage('tpanel'); 552 else FImageIndex := IDEImages.LoadImage('item_unit'); 553 end; 554 if FImageIndex<0 then FImageIndex:=0; 555end; 556 557procedure TViewUnitDialog.SetIdleConnected(AValue: boolean); 558begin 559 if FIdleConnected=AValue then Exit; 560 FIdleConnected:=AValue; 561 if IdleConnected then begin 562 Application.AddOnIdleHandler(@OnIdle); 563 ProgressBar1.Visible:=true; 564 ProgressBar1.Style:=pbstMarquee; 565 end 566 else begin 567 Application.RemoveOnIdleHandler(@OnIdle); 568 ProgressBar1.Visible:=false; 569 end; 570end; 571 572end. 573 574