1 { Form for the scout window
2
3 Copyright (C) 2018 Michael van Canneyt michael@freepascal.org
4
5 This library is free software; you can redistribute it and/or modify it
6 under the terms of the GNU Library General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or (at your
8 option) any later version with the following modification:
9
10 As a special exception, the copyright holders of this library give you
11 permission to link this library with independent modules to produce an
12 executable, regardless of the license terms of these independent modules,and
13 to copy and distribute the resulting executable under terms of your choice,
14 provided that you also meet, for each linked independent module, the terms
15 and conditions of the license of that module. An independent module is a
16 module which is not derived from or based on this library. If you modify
17 this library, you may extend this exception to your version of the library,
18 but you are not obligated to do so. If you do not wish to do so, delete this
19 exception statement from your version.
20
21 This program is distributed in the hope that it will be useful, but WITHOUT
22 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
23 FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
24 for more details.
25
26 You should have received a copy of the GNU Library General Public License
27 along with this library; if not, write to the Free Software Foundation,
28 Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.
29 }
30 unit frmscout;
31
32 {$mode objfpc}{$H+}
33
34 interface
35
36 uses
37 Classes, SysUtils, Types,
38 // LCL
39 LCLType, Forms, Controls, Graphics, Dialogs, StdCtrls, EditBtn,
40 // LazUtils
41 FileUtil, LazUTF8,
42 // BuildIntf, IdeIntf
43 IDEOptionsIntf,
44 ComponentReg, IDECommands, LazIDEIntf, IDEOptEditorIntf,
45 IDEScoutStrConsts;
46
47 Type
48 TScoutTerrain = (stCommands,stRecentProjects,stRecentFiles,stRecentPackages,stComponents);
49 TScoutTerrains = set of TScoutTerrain;
50
51 { TSearchItem }
52 TMatchPos = Array of Integer;
53 TSearchItem = Class(TObject)
54 private
55 FKeyStroke: String;
56 FMatchLen: TMatchPos;
57 FMatchPos: TMatchPos;
58 FOwnsSource: Boolean;
59 FPrefix: String;
60 FSource: TObject;
61 procedure SetSource(AValue: TObject);
62 Public
63 Constructor Create(aSource : TObject;AOwnsSource : Boolean = False);
64 Destructor Destroy; override;
65 published
66 Property OwnsSource: Boolean read FOwnsSource Write FOwnsSource;
67 Property Source : TObject read FSource write FSource;
68 Property KeyStroke : String Read FKeyStroke Write FKeyStroke;
69 Property Prefix : String Read FPrefix Write FPrefix;
70 Property MatchPos : TMatchPos Read FMatchPos Write FMatchPos;
71 Property MatchLen : TMatchPos Read FMatchLen Write FMatchLen;
72 end;
73
74 { TOpenFileItem }
75
76 TOpenFileItem = class(TObject)
77 private
78 FFileName: String;
79 FHandler: TIDERecentHandler;
80 public
81 constructor Create(const AFileName: String; AHandler: TIDERecentHandler);
82 Procedure Execute;
83 Property FileName : String Read FFileName;
84 Property Handler : TIDERecentHandler Read FHandler;
85 end;
86
87 { TComponentItem }
88
89 TComponentItem = class(TObject)
90 private
91 Class Var
92 LastParent : TComponent;
93 LastLeft,LastTop : integer;
FindParentnull94 function FindParent: TComponent;
95 private
96 FComponent : TRegisteredComponent;
97 public
98 Class Var
99 Drop : Boolean;
100 DefaultWidth, DefaultHeight : integer;
101 Public
102 constructor Create(aComponent: TRegisteredComponent);
103 Procedure Execute;
104 Property Component : TRegisteredComponent Read FComponent;
105 end;
106
107
108 { TIDEScoutForm }
109
110 TIDEScoutForm = class(TForm)
111 ESearch: TEditButton;
112 LBMatches: TListBox;
113 procedure ECommandChange(Sender: TObject);
114 procedure ECommandKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
115 procedure ESearchButtonClick(Sender: TObject);
116 procedure FormActivate(Sender: TObject);
117 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
118 procedure FormCreate(Sender: TObject);
119 procedure FormDestroy(Sender: TObject);
120 procedure FormShow(Sender: TObject);
121 procedure LBMatchesClick(Sender: TObject);
122 procedure LBMatchesDrawItem(Control: TWinControl; Index: Integer;
123 ARect: TRect; {%H-}State: TOwnerDrawState);
124 procedure LBMatchesKeyUp(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState
125 );
126 private
127 FRefresh,
128 FHighlights: TScoutTerrains;
129 FKeyStrokeColor: TColor;
130 FMatchColor: TColor;
131 FShowCategory: Boolean;
132 FSearchItems: TStringListUTF8Fast;
133 FOrgCaption : String;
134 FShowShortCutKey: Boolean;
135 procedure ClearRefreshableItems;
136 procedure FillComponents;
137 Procedure RefreshList;
138 procedure FillRecent(aType: TIDERecentHandler);
139 Procedure Initialize;
140 procedure ExecuteSelected;
141 Procedure FillCommands;
142 procedure FilterList(aSearchTerm: String);
143 Procedure AddFileToList(aFileName : String; aType : TIDERecentHandler; CheckDuplicate : Boolean = False);
GetCommandCategoryStringnull144 function GetCommandCategoryString(Cmd: TIDECommand): String;
145 procedure PackageOpened(Sender: TObject; AFileName: string; var AAllow: Boolean);
146 procedure FileOpened(Sender: TObject; AFileName: string; var AAllow: Boolean);
147 procedure ProjectOpened(Sender: TObject; AFileName: string; var AAllow: Boolean);
148 procedure RefreshCaption(aCount: Integer);
149 public
150 Property ShowCategory : Boolean Read FShowCategory Write FShowCategory;
151 Property ShowShortCutKey : Boolean Read FShowShortCutKey Write FShowShortCutKey;
152 property KeyStrokeColor : TColor Read FKeyStrokeColor Write FKeyStrokeColor;
153 property MatchColor : TColor Read FMatchColor Write FMatchColor;
154 Property Highlights : TScoutTerrains Read FHighlights Write FHighlights;
155 end;
156
157
158 Const
159 AllTerrains = [stCommands,stRecentProjects,stRecentFiles,stRecentPackages];
160
161 Var
162 ScoutTerrains : TScoutTerrains = AllTerrains;
163 ShowCmdCategory : Boolean = True;
164 ShowShortCutKey : Boolean = True;
165 MatchColor : TColor = clMaroon;
166 KeyStrokeColor : TColor = clNavy;
167 SettingsClass : TAbstractIDEOptionsEditorClass = Nil;
168
169 Procedure ShowScoutForm;
170 Procedure ApplyScoutOptions;
171 Procedure SaveScoutOptions;
172 procedure LoadScoutOptions;
173 procedure CreateScoutWindow(Sender: TObject; aFormName: string; var AForm: TCustomForm; DoDisableAutoSizing: boolean);
174
175 implementation
176
177 Uses
178 StrUtils, LCLIntf, LCLProc, PackageIntf, BaseIDEIntf, LazConfigStorage, IDEWindowIntf, propedits, srceditorintf, componenteditors;
179
180 {$R *.lfm}
181
182 var
183 ScoutForm: TIDEScoutForm;
184
185
186 Const
187 IDEScoutOptsFile = 'idescout.xml';
188
189 KeyHighLight = 'highlight/';
190 KeyShowCategory = 'showcategory/value';
191 KeyShowShortCut = 'showShortCut/value';
192 KeyShortCutColor = 'ShortCutColor/value';
193 KeyMatchColor = 'MatchColor/value';
194 KeyDefaultComponentWidth = 'Components/DefaultWidth';
195 KeyDefaultComponentHeight = 'Components/DefaultHeight';
196 KeyDropComponent = 'Components/Drop';
197
198
199 HighlightNames : Array[TScoutTerrain] of string =
200 ('Commands','Projects','Files','Packages','Components');
201
202 procedure LoadScoutOptions;
203 var
204 Cfg: TConfigStorage;
205 SH : TScoutTerrain;
206 SHS : TScoutTerrains;
207
208 begin
209 Cfg:=GetIDEConfigStorage(IDEScoutOptsFile,true);
210 try
211 SHS:=[];
212 for SH in TScoutTerrain do
213 if Cfg.GetValue(KeyHighLight+HighlightNames[SH],SH In ScoutTerrains) then
214 Include(SHS,SH);
215 ScoutTerrains:=SHS;
216 TComponentItem.DefaultWidth:=Cfg.GetValue(KeyDefaultComponentWidth,TComponentItem.DefaultWidth);
217 TComponentItem.DefaultHeight:=Cfg.GetValue(KeyDefaultComponentHeight,TComponentItem.DefaultHeight);
218 TComponentItem.Drop:=Cfg.GetValue(KeyDropComponent,TComponentItem.Drop);
219 ShowCmdCategory:=Cfg.GetValue(KeyShowCategory,ShowCmdCategory);
220 ShowShortCutKey:=Cfg.GetValue(KeyShowShortCut,ShowShortCutKey);
221 KeyStrokeColor:=TColor(Cfg.GetValue(KeyShortCutColor,Ord(KeyStrokeColor)));
222 MatchColor:=TColor(Cfg.GetValue(KeyMatchColor,Ord(MatchColor)));
223 ApplyScoutOptions;
224 finally
225 Cfg.Free;
226 end;
227 end;
228
229
230 procedure SaveScoutOptions;
231 var
232 Cfg: TConfigStorage;
233 SH : TScoutTerrain;
234
235 begin
236 Cfg:=GetIDEConfigStorage(IDEScoutOptsFile,false);
237 try
238 for SH in TScoutTerrain do
239 Cfg.SetValue(KeyHighLight+HighlightNames[SH],SH In ScoutTerrains);
240 Cfg.SetValue(KeyDefaultComponentWidth,TComponentItem.DefaultWidth);
241 Cfg.SetValue(KeyDefaultComponentHeight,TComponentItem.DefaultHeight);
242 Cfg.SetValue(KeyDropComponent,TComponentItem.Drop);
243 Cfg.SetValue(KeyShowCategory,ShowCmdCategory);
244 Cfg.SetValue(KeyShowShortCut,ShowShortCutKey);
245 Cfg.SetValue(KeyShortCutColor,Ord(KeyStrokeColor));
246 Cfg.SetValue(KeyMatchColor,Ord(MatchColor));
247 finally
248 Cfg.Free;
249 end;
250 end;
251
252 Procedure ApplyScoutOptions;
253
254 begin
255 if Assigned(ScoutForm) then
256 begin
257 ScoutForm.ShowCategory:=ShowCmdCategory;
258 ScoutForm.MatchColor:=MatchColor;
259 ScoutForm.KeyStrokeColor:=KeyStrokeColor;
260 ScoutForm.ShowShortCutKey:=ShowShortCutKey;
261 ScoutForm.Highlights:=ScoutTerrains;
262 ScoutForm.Initialize;
263 end;
264 end;
265
266 Procedure MaybeCreateScoutForm;
267
268 begin
269 if ScoutForm=Nil then
270 begin
271 ScoutForm:=TIDEScoutForm.Create(Application);
272 ApplyScoutOptions;
273 end;
274 end;
275
276 Procedure ShowScoutForm;
277
278 begin
279 MaybeCreateScoutForm;
280 IDEWindowCreators.ShowForm(ScoutForm,True,vmAlwaysMoveToVisible);
281 end;
282
283
284 procedure CreateScoutWindow(Sender: TObject; aFormName: string;
285 var AForm: TCustomForm; DoDisableAutoSizing: boolean);
286 begin
287 MaybeCreateScoutForm;
288 aForm:=ScoutForm;
289 end;
290
291 { TComponentItem }
292
293 constructor TComponentItem.Create(aComponent: TRegisteredComponent);
294 begin
295 FComponent:=aComponent;
296 end;
297
TComponentItem.FindParentnull298 Function TComponentItem.FindParent : TComponent;
299
300 Var
301 ASelections: TPersistentSelectionList;
302 begin
303 Result:=Nil;
304 ASelections := TPersistentSelectionList.Create;
305 try
306 GlobalDesignHook.GetSelection(ASelections);
307 if (ASelections.Count>0) and (ASelections[0] is TComponent) then
308 Result := TComponent(ASelections[0])
309 else if GlobalDesignHook.LookupRoot is TComponent then
310 Result:= TComponent(GlobalDesignHook.LookupRoot)
311 else
312 Result := nil;
313 finally
314 ASelections.Free;
315 end;
316 end;
317
318 procedure TComponentItem.Execute;
319
320 var
321 NewParent: TComponent;
322 RootDesigner : TIDesigner;
323 CompDesigner : TComponentEditorDesigner;
324
325 begin
326 IDEComponentPalette.SetSelectedComp(FComponent,False);
327 if not Drop then
328 exit;
329 NewParent:=FindParent;
330 if NewParent=nil then
331 Exit;
332 RootDesigner:=FindRootDesigner(NewParent);
333 if not (RootDesigner is TComponentEditorDesigner) then
334 exit;
335 CompDesigner:=RootDesigner as TComponentEditorDesigner;
336 CompDesigner.AddComponentCheckParent(NewParent, NewParent, nil, FComponent.ComponentClass);
337 if NewParent=nil then
338 Exit;
339 if LastParent<>NewParent then
340 begin
341 LastLeft := 0;
342 LastTop := 0;
343 LastParent := NewParent;
344 end;
345 Inc(LastLeft, 8);
346 Inc(LastTop, 8);
347 CompDesigner.AddComponent(FComponent, FComponent.ComponentClass, NewParent, Lastleft, LastTop, DefaultWidth, DefaultHeight);
348 end;
349
350 { TOpenFileItem }
351
352 constructor TOpenFileItem.Create(const AFileName : String; AHandler: TIDERecentHandler);
353 begin
354 FFileName:=AFileName;
355 FHandler:=aHandler;
356 end;
357
358 procedure TOpenFileItem.Execute;
359 begin
360 case fHandler of
361 irhProjectFiles : LazarusIDE.DoOpenProjectFile(FileName,[ofAddToRecent]);
362 irhOpenFiles : LazarusIDE.DoOpenEditorFile(FileName,-1,-1,[ofAddToRecent]);
363 irhPackageFiles : PackageEditingInterface.DoOpenPackageFile(FFileName,[pofAddToRecent],False);
364 end;
365 end;
366
367 { TSearchItem }
368
369 procedure TSearchItem.SetSource(AValue: TObject);
370 begin
371 if FSource=AValue then Exit;
372 FSource:=AValue;
373 end;
374
375 constructor TSearchItem.Create(aSource: TObject; AOwnsSource: Boolean);
376 begin
377 FSource:=aSource;
378 FOwnsSource:=AOwnsSource;
379 end;
380
381 destructor TSearchItem.Destroy;
382 begin
383 if OwnsSource then
384 FreeAndNil(FSource);
385 Inherited;
386 end;
387
388 { TIDEScoutForm }
389
390 procedure TIDEScoutForm.ECommandChange(Sender: TObject);
391 begin
392 FilterList(ESearch.Text);
393 end;
394
395 procedure TIDEScoutForm.ECommandKeyDown(Sender: TObject; var Key: Word;
396 Shift: TShiftState);
397 begin
398 Case Key of
399 VK_ESCAPE: Hide;
400 VK_UP:
401 begin
402 If LBMatches.ItemIndex>0 then
403 LBMatches.ItemIndex:=LBMatches.ItemIndex-1;
404 Key:=0;
405 ESearch.SelStart:=Length(ESearch.Text);
406 end;
407 VK_DOWN:
408 begin
409 If LBMatches.ItemIndex<LBMatches.Items.Count-1 then
410 LBMatches.ItemIndex:=LBMatches.ItemIndex+1;
411 Key:=0;
412 ESearch.SelStart:=Length(ESearch.Text);
413 end;
414 VK_RETURN :
415 If LBMatches.ItemIndex>=0 then
416 ExecuteSelected;
417 end;
418 end;
419
420 procedure TIDEScoutForm.ESearchButtonClick(Sender: TObject);
421 begin
422 LazarusIDE.DoOpenIDEOptions(SettingsClass,'IDE Scout');
423 Close;
424 end;
425
426
427 procedure TIDEScoutForm.FormActivate(Sender: TObject);
428 begin
429 ESearch.SetFocus;
430 end;
431
432 procedure TIDEScoutForm.FormClose(Sender: TObject;
433 var CloseAction: TCloseAction);
434 begin
435 CloseAction:=caHide;
436 end;
437
438 procedure TIDEScoutForm.RefreshCaption(aCount : Integer);
439
440 begin
441 if ACount=-1 then
442 Caption:=FOrgCaption+Format(' (%d)',[FSearchItems.Count])
443 else
444 Caption:=FOrgCaption+Format(' (%d/%d)',[aCount,FSearchItems.Count]);
445 end;
446
447 procedure TIDEScoutForm.FilterList(aSearchTerm: String);
448
449 Var
450 i : Integer;
451 Itm : TSearchItem;
452 Words : Array of string;
453 MatchPos : Array of Integer;
454 MatchLen : Array of Integer;
455
Matchnull456 Function Match(S : String) : Boolean;
457
458 Var
459 I : integer;
460
461 begin
462 Result:=True;
463 I:=0;
464 While Result and (I<Length(Words)) do
465 begin
466 MatchPos[i]:=Pos(Words[i],S);
467 Result:=MatchPos[i]<>0;
468 inc(I);
469 end;
470 end;
471
472 begin
473 if (ASearchTerm='') then
474 begin
475 LBMatches.Clear;
476 Exit;
477 end;
478 aSearchTerm:=LowerCase(aSearchTerm);
479 Setlength(Words,WordCount(aSearchTerm,[' ']));
480 Setlength(MatchPos,Length(Words));
481 Setlength(MatchLen,Length(Words));
482 For I:=1 to Length(Words) do
483 begin
484 Words[I-1]:=ExtractWord(I,aSearchTerm,[' ']);
485 MatchLen[I-1]:=Length(Words[I-1]);
486 end;
487 LBMatches.Items.BeginUpdate;
488 try
489 LBMatches.Items.Clear;
490 For I:=0 to FSearchItems.Count-1 do
491 if Match(FSearchItems[I]) then
492 begin
493 Itm:=FSearchItems.Objects[I] as TSearchItem;
494 Itm.MatchPos:=Copy(MatchPos,0,Length(MatchPos));
495 Itm.MatchLen:=Copy(MatchLen,0,Length(MatchLen));
496 LBMatches.Items.AddObject(FSearchItems[I],Itm);
497 end;
498 RefreshCaption(LBMatches.Items.Count);
499 finally
500 LBMatches.Items.EndUpdate;
501 LBMatches.Visible:=LBMatches.Items.Count>0;
502 If LBMatches.Visible then
503 LBMatches.ItemIndex:=0;
504 end;
505 end;
506
507 procedure TIDEScoutForm.AddFileToList(aFileName: String; aType: TIDERecentHandler; CheckDuplicate : Boolean = False);
508
509 Var
510 F : TOpenFileItem;
511 SI : TSearchItem;
512 FN,Prefix : String;
513
514 begin
515 if ShowCategory then
516 Case aType of
517 irhPackageFiles : Prefix:='Package: ';
518 irhProjectFiles : Prefix:='Project: ';
519 irhOpenFiles : Prefix:='File: ';
520 end;
521 FN:=Prefix+aFileName;
522 if (Not CheckDuplicate) or (FSearchItems.IndexOf(FN)=-1) then
523 begin
524 F:=TOpenFileItem.Create(aFileName,aType);
525 SI:=TSearchItem.Create(F,True);
526 SI.Prefix:=Prefix;
527 FSearchItems.AddObject(FN,SI);
528 end;
529
530 end;
531
532 procedure TIDEScoutForm.FormCreate(Sender: TObject);
533 begin
534 FSearchItems:=TStringListUTF8Fast.Create;
535 FSearchItems.OwnsObjects:=True;
536 Caption:=isrsIDEScout;
537 FOrgCaption:=Caption;
538 ESearch.TextHint:=isrsTypeSearchTerms;
539 end;
540
541 procedure TIDEScoutForm.FormDestroy(Sender: TObject);
542 begin
543 With IDEEnvironmentOptions do
544 begin
545 RemoveHandlerAddToRecentOpenFiles(@PackageOpened);
546 RemoveHandlerAddToRecentProjectFiles(@FileOpened);
547 RemoveHandlerAddToRecentPackageFiles(@ProjectOpened);
548 end;
549 FreeAndNil(FSearchItems);
550 ScoutForm:=Nil;
551 end;
552
553 procedure TIDEScoutForm.FormShow(Sender: TObject);
554
555 begin
556 ESearch.Clear;
557 LBMatches.Clear;
558 RefreshCaption(-1);
559 if FRefresh<>[] then
560 RefreshList;
561 end;
562
563 procedure TIDEScoutForm.LBMatchesClick(Sender: TObject);
564
565 begin
566 ExecuteSelected;
567 end;
568
569 procedure TIDEScoutForm.LBMatchesDrawItem(Control: TWinControl; Index: Integer;
570 ARect: TRect; State: TOwnerDrawState);
571
572 Const
573 LeftMargin = 5;
574 RightMargin = LeftMargin;
575
576 Var
577 LB : TListbox;
578 DS,S : String;
579 Itm : TSearchItem;
580 R : TRect;
581 P,I,SP,W : Integer;
582 FC : TColor;
583
584 begin
585 LB:=Control as TListBox;
586 LB.Canvas.FillRect(ARect);
587 FC:=LB.Canvas.Font.Color;
588 Itm:=LB.Items.Objects[Index] as TSearchItem;
589 S:=LB.Items[Index];
590 R:=ARect;
591 if ShowShortCutKey and (Itm.KeyStroke<>'') then
592 begin
593 W:=LB.Canvas.TextWidth(Itm.KeyStroke);
594 R.Right:=R.Right-W-RightMargin;
595 end;
596 Inc(R.Left,LeftMargin);
597 SP:=1;
598 For I:=0 to Length(Itm.MatchPos)-1 do
599 begin
600 P:=Itm.MatchPos[i];
601 if (P-SP>0) then
602 begin
603 DS:=Copy(S,SP,P-SP);
604 LB.Canvas.TextRect(R,R.Left,R.Top,DS);
605 Inc(R.Left,LB.Canvas.TextWidth(DS));
606 end;
607 DS:=Copy(S,P,Itm.MatchLen[i]);
608 LB.Canvas.Font.Color:=MatchColor;
609 LB.Canvas.TextRect(R,R.Left,R.Top,DS);
610 LB.Canvas.Font.Color:=FC;
611 Inc(R.Left,LB.Canvas.TextWidth(DS));
612 SP:=P+Itm.MatchLen[i];
613 end;
614 if SP<=Length(S) then
615 begin
616 DS:=Copy(S,SP,Length(S)-SP+1);
617 LB.Canvas.TextRect(R,R.Left,R.Top,DS);
618 end;
619 if Itm.KeyStroke<>'' then
620 begin
621 R.Left:=R.Right+1;
622 R.Right:=aRect.Right;
623 LB.Canvas.Font.Color:=KeyStrokeColor;
624 LB.Canvas.TextRect(R,R.Left,R.Top,Itm.KeyStroke);
625 end;
626 end;
627
628 procedure TIDEScoutForm.ExecuteSelected;
629
630 Var
631 idx: Integer;
632 itm : TSearchItem;
633
634 begin
635 Idx:=LBMatches.ItemIndex;
636 if (Idx>=0) then
637 begin
638 Hide;
639 Itm:=LBMatches.Items.Objects[Idx] as TSearchItem;
640 if Itm.Source is TIDECommand then
641 TIDECommand(Itm.Source).Execute(SourceEditorManagerIntf.ActiveEditor)
642 else if Itm.Source is TComponentItem then
643 TComponentItem(Itm.Source).Execute
644 else if Itm.Source is TOpenFileItem then
645 TOpenFileItem(Itm.Source).Execute;
646 end;
647 end;
648
649
650 procedure TIDEScoutForm.LBMatchesKeyUp(Sender: TObject; var Key: Word;
651 Shift: TShiftState);
652 begin
653 if Key=VK_ESCAPE then
654 Hide;
655 end;
656
657 procedure TIDEScoutForm.FillRecent(aType : TIDERecentHandler);
658
659 Var
660 L : TStringList;
661 S : String;
662
663 begin
664 L:=TstringList.Create;
665 try
666 IDEEnvironmentOptions.GetRecentFiles(aType,L);
667 For S in L do
668 AddFileToList(S,aType,False);
669 finally
670 L.Free;
671 end;
672 end;
673
674 procedure TIDEScoutForm.FillComponents;
675
676 Var
677 I : integer;
678 Prefix,CC : String;
679 RC : TRegisteredComponent;
680 SI : TSearchItem;
681
682 begin
683 For I:=0 to IDEComponentPalette.Comps.Count-1 do
684 begin
685 RC:=IDEComponentPalette.Comps[I];
686 if RC.CanBeCreatedInDesigner then
687 begin
688 CC:=RC.ComponentClass.ClassName+' ('+RC.GetUnitName+')';
689 Prefix:='Component: ';
690 SI:=TSearchItem.Create(TComponentItem.Create(RC),True);
691 SI.Prefix:=Prefix;
692 FSearchItems.AddObject(UTF8LowerCase(Prefix+CC),SI);
693 end;
694 end;
695 end;
696
697 procedure TIDEScoutForm.ClearRefreshableItems;
698
699 Var
700 I : Integer;
701 Si : TSearchItem;
702 SH : Set of TIDERecentHandler;
703
704 begin
705 SH:=[];
706 if stRecentFiles in FRefresh then
707 Include(SH,irhOpenFiles);
708 if stRecentProjects in FRefresh then
709 Include(SH,irhProjectFiles);
710 if stRecentPackages in FRefresh then
711 Include(SH,irhPackageFiles);
712 I:=FSearchItems.Count-1;
713 While I>=0 do
714 begin
715 SI:=TSearchItem(FSearchItems.Objects[i]);
716 if (SI.Source is TOpenFileItem) then
717 if TOpenFileItem(SI.Source).Handler in SH then
718 FSearchItems.Delete(I);
719 Dec(I);
720 end;
721 end;
722
723 procedure TIDEScoutForm.RefreshList;
724
725 begin
726 FSearchItems.Sorted:=False;
727 FSearchItems.BeginUpdate;
728 try
729 ClearRefreshableItems;
730 if stRecentFiles in FRefresh then
731 FillRecent(irhOpenFiles);
732 if stRecentProjects in FRefresh then
733 FillRecent(irhProjectFiles);
734 if stRecentPackages in FRefresh then
735 FillRecent(irhPackageFiles);
736 FRefresh:=[];
737 finally
738 FSearchItems.Sorted:=True;
739 FSearchItems.EndUpdate;
740 end;
741 end;
742
743 procedure TIDEScoutForm.Initialize;
744 begin
745 FSearchItems.Sorted:=False;
746 FSearchItems.BeginUpdate;
747 try
748 FSearchItems.Clear;
749 if stCommands in Highlights then
750 FillCommands;
751 if stComponents in Highlights then
752 FillComponents;
753 if stRecentFiles in Highlights then
754 begin
755 IDEEnvironmentOptions.AddHandlerAddToRecentOpenFiles(@FileOpened,False);
756 FillRecent(irhOpenFiles);
757 end;
758 if stRecentProjects in Highlights then
759 begin
760 IDEEnvironmentOptions.AddHandlerAddToRecentProjectFiles(@ProjectOpened,False);
761 FillRecent(irhProjectFiles);
762 end;
763 if stRecentPackages in Highlights then
764 begin
765 IDEEnvironmentOptions.AddHandlerAddToRecentPackageFiles(@PackageOpened,False);
766 FillRecent(irhPackageFiles);
767 end;
768 finally
769 FSearchItems.Sorted:=True;
770 FSearchItems.EndUpdate;
771 end;
772 end;
773
TIDEScoutForm.GetCommandCategoryStringnull774 function TIDEScoutForm.GetCommandCategoryString(Cmd: TIDECommand): String;
775
776 Const
777 Cmds = ' commands';
778
779 Var
780 Cat: TIDECommandCategory;
781 D : String;
782 P : Integer;
783
784 begin
785 Result:='';
786 If Not ShowCategory then
787 Exit;
788 Cat:=Cmd.Category;
789 While (Cat<>Nil) and (Cat.Parent<>Nil) do
790 Cat:=Cat.Parent;
791 If Cat<>Nil then
792 begin
793 D:=Cat.Description;
794 P:=Pos(' commands',D);
795 If (P>0) and (P=Length(D)-Length(Cmds)+1) then
796 D:=Copy(D,1,P-1);
797 Result:=D+': ';
798 end;
799 end;
800
801 procedure TIDEScoutForm.PackageOpened(Sender: TObject; AFileName: string;
802 var AAllow: Boolean);
803 begin
804 Include(FRefresh,stRecentPackages);
805 end;
806
807 procedure TIDEScoutForm.FileOpened(Sender: TObject; AFileName: string;
808 var AAllow: Boolean);
809 begin
810 Include(FRefresh,stRecentFiles);
811 end;
812
813 procedure TIDEScoutForm.ProjectOpened(Sender: TObject; AFileName: string;
814 var AAllow: Boolean);
815 begin
816 Include(FRefresh,stRecentProjects);
817 end;
818
819 procedure TIDEScoutForm.FillCommands;
820 var
821 I, J: Integer;
822 Itm : TSearchItem;
823 Cmd : TIDECommand;
824 Ks,Pref : String;
825
826 begin
827 For I:=0 to IDECommandList.CategoryCount-1 do
828 for J:=0 to IDECommandList.Categories[I].Count-1 do
829 begin
830 if TObject(IDECommandList.Categories[I].Items[J]) is TIDECommand then
831 begin
832 Cmd:=TIDECommand(IDECommandList.Categories[I].Items[J]);
833 Pref:=GetCommandCategoryString(Cmd);
834 ks:='';
835 if Cmd.ShortcutA.Key1<>VK_UNKNOWN then
836 begin
837 ks:=' ('+KeyAndShiftStateToKeyString(Cmd.ShortcutA.Key1,Cmd.ShortcutA.Shift1);
838 if Cmd.ShortcutA.Key2<>VK_UNKNOWN then
839 ks:=Ks+', '+KeyAndShiftStateToKeyString(Cmd.ShortcutA.Key2,Cmd.ShortcutA.Shift2);
840 ks:=ks+')';
841 end;
842 Itm:=TSearchItem.Create(Cmd);
843 Itm.Prefix:=Pref;
844 Itm.KeyStroke:=Ks;
845 FSearchItems.AddObject(UTF8LowerCase(Pref+Cmd.LocalizedName),Itm);
846 end;
847 end;
848 RefreshCaption(-1);
849 end;
850
851 end.
852
853