mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-06 02:12:41 +02:00
846 lines
22 KiB
ObjectPascal
846 lines
22 KiB
ObjectPascal
{ Form for the scout window
|
|
|
|
Copyright (C) 2018 Michael van Canneyt michael@freepascal.org
|
|
|
|
This library is free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU Library General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or (at your
|
|
option) any later version with the following modification:
|
|
|
|
As a special exception, the copyright holders of this library give you
|
|
permission to link this library with independent modules to produce an
|
|
executable, regardless of the license terms of these independent modules,and
|
|
to copy and distribute the resulting executable under terms of your choice,
|
|
provided that you also meet, for each linked independent module, the terms
|
|
and conditions of the license of that module. An independent module is a
|
|
module which is not derived from or based on this library. If you modify
|
|
this library, you may extend this exception to your version of the library,
|
|
but you are not obligated to do so. If you do not wish to do so, delete this
|
|
exception statement from your version.
|
|
|
|
This program is distributed in the hope that it will be useful, but WITHOUT
|
|
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
|
|
for more details.
|
|
|
|
You should have received a copy of the GNU Library General Public License
|
|
along with this library; if not, write to the Free Software Foundation,
|
|
Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.
|
|
}
|
|
unit frmscout;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, LazUTF8, Forms, Controls, Graphics, Dialogs, ComponentReg,
|
|
StdCtrls, EditBtn, IDECommands, LazIDEIntf, Types, LCLType, IDEOptionsIntf, IDEOptEditorIntf, IDEScoutStrConsts;
|
|
|
|
Type
|
|
TScoutTerrain = (stCommands,stRecentProjects,stRecentFiles,stRecentPackages,stComponents);
|
|
TScoutTerrains = set of TScoutTerrain;
|
|
|
|
{ TSearchItem }
|
|
TMatchPos = Array of Integer;
|
|
TSearchItem = Class(TObject)
|
|
private
|
|
FKeyStroke: String;
|
|
FMatchLen: TMatchPos;
|
|
FMatchPos: TMatchPos;
|
|
FOwnsSource: Boolean;
|
|
FPrefix: String;
|
|
FSource: TObject;
|
|
procedure SetSource(AValue: TObject);
|
|
Public
|
|
Constructor Create(aSource : TObject;AOwnsSource : Boolean = False);
|
|
Destructor Destroy; override;
|
|
published
|
|
Property OwnsSource: Boolean read FOwnsSource Write FOwnsSource;
|
|
Property Source : TObject read FSource write FSource;
|
|
Property KeyStroke : String Read FKeyStroke Write FKeyStroke;
|
|
Property Prefix : String Read FPrefix Write FPrefix;
|
|
Property MatchPos : TMatchPos Read FMatchPos Write FMatchPos;
|
|
Property MatchLen : TMatchPos Read FMatchLen Write FMatchLen;
|
|
end;
|
|
|
|
{ TOpenFileItem }
|
|
|
|
TOpenFileItem = class(TObject)
|
|
private
|
|
FFileName: String;
|
|
FHandler: TIDERecentHandler;
|
|
public
|
|
constructor Create(const AFileName: String; AHandler: TIDERecentHandler);
|
|
Procedure Execute;
|
|
Property FileName : String Read FFileName;
|
|
Property Handler : TIDERecentHandler Read FHandler;
|
|
end;
|
|
|
|
{ TComponentItem }
|
|
|
|
TComponentItem = class(TObject)
|
|
private
|
|
Class Var
|
|
LastParent : TComponent;
|
|
LastLeft,LastTop : integer;
|
|
function FindParent: TComponent;
|
|
private
|
|
FComponent : TRegisteredComponent;
|
|
public
|
|
Class Var
|
|
Drop : Boolean;
|
|
DefaultWidth, DefaultHeight : integer;
|
|
Public
|
|
constructor Create(aComponent: TRegisteredComponent);
|
|
Procedure Execute;
|
|
Property Component : TRegisteredComponent Read FComponent;
|
|
end;
|
|
|
|
|
|
{ TIDEScoutForm }
|
|
|
|
TIDEScoutForm = class(TForm)
|
|
ESearch: TEditButton;
|
|
LBMatches: TListBox;
|
|
procedure ECommandChange(Sender: TObject);
|
|
procedure ECommandKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
|
|
procedure ESearchButtonClick(Sender: TObject);
|
|
procedure FormActivate(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure LBMatchesClick(Sender: TObject);
|
|
procedure LBMatchesDrawItem(Control: TWinControl; Index: Integer;
|
|
ARect: TRect; {%H-}State: TOwnerDrawState);
|
|
procedure LBMatchesKeyUp(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState
|
|
);
|
|
private
|
|
FRefresh,
|
|
FHighlights: TScoutTerrains;
|
|
FKeyStrokeColor: TColor;
|
|
FMatchColor: TColor;
|
|
FShowCategory: Boolean;
|
|
FSearchItems: TStringList;
|
|
FOrgCaption : String;
|
|
FShowShortCutKey: Boolean;
|
|
procedure ClearRefreshableItems;
|
|
procedure FillComponents;
|
|
Procedure RefreshList;
|
|
procedure FillRecent(aType: TIDERecentHandler);
|
|
Procedure Initialize;
|
|
procedure ExecuteSelected;
|
|
Procedure FillCommands;
|
|
procedure FilterList(aSearchTerm: String);
|
|
Procedure AddFileToList(aFileName : String; aType : TIDERecentHandler; CheckDuplicate : Boolean = False);
|
|
function GetCommandCategoryString(Cmd: TIDECommand): String;
|
|
procedure PackageOpened(Sender: TObject; AFileName: string; var AAllow: Boolean);
|
|
procedure FileOpened(Sender: TObject; AFileName: string; var AAllow: Boolean);
|
|
procedure ProjectOpened(Sender: TObject; AFileName: string; var AAllow: Boolean);
|
|
procedure RefreshCaption(aCount: Integer);
|
|
public
|
|
Property ShowCategory : Boolean Read FShowCategory Write FShowCategory;
|
|
Property ShowShortCutKey : Boolean Read FShowShortCutKey Write FShowShortCutKey;
|
|
property KeyStrokeColor : TColor Read FKeyStrokeColor Write FKeyStrokeColor;
|
|
property MatchColor : TColor Read FMatchColor Write FMatchColor;
|
|
Property Highlights : TScoutTerrains Read FHighlights Write FHighlights;
|
|
end;
|
|
|
|
|
|
Const
|
|
AllTerrains = [stCommands,stRecentProjects,stRecentFiles,stRecentPackages];
|
|
|
|
Var
|
|
ScoutTerrains : TScoutTerrains = AllTerrains;
|
|
ShowCmdCategory : Boolean = True;
|
|
ShowShortCutKey : Boolean = True;
|
|
MatchColor : TColor = clMaroon;
|
|
KeyStrokeColor : TColor = clNavy;
|
|
SettingsClass : TAbstractIDEOptionsEditorClass = Nil;
|
|
|
|
Procedure ShowScoutForm;
|
|
Procedure ApplyScoutOptions;
|
|
Procedure SaveScoutOptions;
|
|
procedure LoadScoutOptions;
|
|
procedure CreateScoutWindow(Sender: TObject; aFormName: string; var AForm: TCustomForm; DoDisableAutoSizing: boolean);
|
|
|
|
implementation
|
|
|
|
Uses
|
|
StrUtils, LCLIntf, LCLProc, PackageIntf, BaseIDEIntf, LazConfigStorage, IDEWindowIntf, propedits, srceditorintf, componenteditors;
|
|
|
|
{$R *.lfm}
|
|
|
|
var
|
|
ScoutForm: TIDEScoutForm;
|
|
|
|
|
|
Const
|
|
IDEScoutOptsFile = 'idescout.xml';
|
|
|
|
KeyHighLight = 'highlight/';
|
|
KeyShowCategory = 'showcategory/value';
|
|
KeyShowShortCut = 'showShortCut/value';
|
|
KeyShortCutColor = 'ShortCutColor/value';
|
|
KeyMatchColor = 'MatchColor/value';
|
|
KeyDefaultComponentWidth = 'Components/DefaultWidth';
|
|
KeyDefaultComponentHeight = 'Components/DefaultHeight';
|
|
KeyDropComponent = 'Components/Drop';
|
|
|
|
|
|
HighlightNames : Array[TScoutTerrain] of string =
|
|
('Commands','Projects','Files','Packages','Components');
|
|
|
|
procedure LoadScoutOptions;
|
|
var
|
|
Cfg: TConfigStorage;
|
|
SH : TScoutTerrain;
|
|
SHS : TScoutTerrains;
|
|
|
|
begin
|
|
Cfg:=GetIDEConfigStorage(IDEScoutOptsFile,true);
|
|
try
|
|
SHS:=[];
|
|
for SH in TScoutTerrain do
|
|
if Cfg.GetValue(KeyHighLight+HighlightNames[SH],SH In ScoutTerrains) then
|
|
Include(SHS,SH);
|
|
ScoutTerrains:=SHS;
|
|
TComponentItem.DefaultWidth:=Cfg.GetValue(KeyDefaultComponentWidth,TComponentItem.DefaultWidth);
|
|
TComponentItem.DefaultHeight:=Cfg.GetValue(KeyDefaultComponentHeight,TComponentItem.DefaultHeight);
|
|
TComponentItem.Drop:=Cfg.GetValue(KeyDropComponent,TComponentItem.Drop);
|
|
ShowCmdCategory:=Cfg.GetValue(KeyShowCategory,ShowCmdCategory);
|
|
ShowShortCutKey:=Cfg.GetValue(KeyShowShortCut,ShowShortCutKey);
|
|
KeyStrokeColor:=TColor(Cfg.GetValue(KeyShortCutColor,Ord(KeyStrokeColor)));
|
|
MatchColor:=TColor(Cfg.GetValue(KeyMatchColor,Ord(MatchColor)));
|
|
ApplyScoutOptions;
|
|
finally
|
|
Cfg.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure SaveScoutOptions;
|
|
var
|
|
Cfg: TConfigStorage;
|
|
SH : TScoutTerrain;
|
|
|
|
begin
|
|
Cfg:=GetIDEConfigStorage(IDEScoutOptsFile,false);
|
|
try
|
|
for SH in TScoutTerrain do
|
|
Cfg.SetValue(KeyHighLight+HighlightNames[SH],SH In ScoutTerrains);
|
|
Cfg.SetValue(KeyDefaultComponentWidth,TComponentItem.DefaultWidth);
|
|
Cfg.SetValue(KeyDefaultComponentHeight,TComponentItem.DefaultHeight);
|
|
Cfg.SetValue(KeyDropComponent,TComponentItem.Drop);
|
|
Cfg.SetValue(KeyShowCategory,ShowCmdCategory);
|
|
Cfg.SetValue(KeyShowShortCut,ShowShortCutKey);
|
|
Cfg.SetValue(KeyShortCutColor,Ord(KeyStrokeColor));
|
|
Cfg.SetValue(KeyMatchColor,Ord(MatchColor));
|
|
finally
|
|
Cfg.Free;
|
|
end;
|
|
end;
|
|
|
|
Procedure ApplyScoutOptions;
|
|
|
|
begin
|
|
if Assigned(ScoutForm) then
|
|
begin
|
|
ScoutForm.ShowCategory:=ShowCmdCategory;
|
|
ScoutForm.MatchColor:=MatchColor;
|
|
ScoutForm.KeyStrokeColor:=KeyStrokeColor;
|
|
ScoutForm.ShowShortCutKey:=ShowShortCutKey;
|
|
ScoutForm.Highlights:=ScoutTerrains;
|
|
ScoutForm.Initialize;
|
|
end;
|
|
end;
|
|
|
|
Procedure MaybeCreateScoutForm;
|
|
|
|
begin
|
|
if ScoutForm=Nil then
|
|
begin
|
|
ScoutForm:=TIDEScoutForm.Create(Application);
|
|
ApplyScoutOptions;
|
|
end;
|
|
end;
|
|
|
|
Procedure ShowScoutForm;
|
|
|
|
begin
|
|
MaybeCreateScoutForm;
|
|
IDEWindowCreators.ShowForm(ScoutForm,True,vmAlwaysMoveToVisible);
|
|
end;
|
|
|
|
|
|
procedure CreateScoutWindow(Sender: TObject; aFormName: string;
|
|
var AForm: TCustomForm; DoDisableAutoSizing: boolean);
|
|
begin
|
|
MaybeCreateScoutForm;
|
|
aForm:=ScoutForm;
|
|
end;
|
|
|
|
{ TComponentItem }
|
|
|
|
constructor TComponentItem.Create(aComponent: TRegisteredComponent);
|
|
begin
|
|
FComponent:=aComponent;
|
|
end;
|
|
|
|
Function TComponentItem.FindParent : TComponent;
|
|
|
|
Var
|
|
ASelections: TPersistentSelectionList;
|
|
begin
|
|
Result:=Nil;
|
|
ASelections := TPersistentSelectionList.Create;
|
|
try
|
|
GlobalDesignHook.GetSelection(ASelections);
|
|
if (ASelections.Count>0) and (ASelections[0] is TComponent) then
|
|
Result := TComponent(ASelections[0])
|
|
else if GlobalDesignHook.LookupRoot is TComponent then
|
|
Result:= TComponent(GlobalDesignHook.LookupRoot)
|
|
else
|
|
Result := nil;
|
|
finally
|
|
ASelections.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TComponentItem.Execute;
|
|
|
|
var
|
|
NewParent: TComponent;
|
|
RootDesigner : TIDesigner;
|
|
CompDesigner : TComponentEditorDesigner;
|
|
|
|
begin
|
|
IDEComponentPalette.SetSelectedComp(FComponent,False);
|
|
if not Drop then
|
|
exit;
|
|
NewParent:=FindParent;
|
|
if NewParent=nil then
|
|
Exit;
|
|
RootDesigner:=FindRootDesigner(NewParent);
|
|
if not (RootDesigner is TComponentEditorDesigner) then
|
|
exit;
|
|
CompDesigner:=RootDesigner as TComponentEditorDesigner;
|
|
CompDesigner.AddComponentCheckParent(NewParent, NewParent, nil, FComponent.ComponentClass);
|
|
if NewParent=nil then
|
|
Exit;
|
|
if LastParent<>NewParent then
|
|
begin
|
|
LastLeft := 0;
|
|
LastTop := 0;
|
|
LastParent := NewParent;
|
|
end;
|
|
Inc(LastLeft, 8);
|
|
Inc(LastTop, 8);
|
|
CompDesigner.AddComponent(FComponent, FComponent.ComponentClass, NewParent, Lastleft, LastTop, DefaultWidth, DefaultHeight);
|
|
end;
|
|
|
|
{ TOpenFileItem }
|
|
|
|
constructor TOpenFileItem.Create(const AFileName : String; AHandler: TIDERecentHandler);
|
|
begin
|
|
FFileName:=AFileName;
|
|
FHandler:=aHandler;
|
|
end;
|
|
|
|
procedure TOpenFileItem.Execute;
|
|
begin
|
|
case fHandler of
|
|
irhProjectFiles : LazarusIDE.DoOpenProjectFile(FileName,[ofAddToRecent]);
|
|
irhOpenFiles : LazarusIDE.DoOpenEditorFile(FileName,-1,-1,[ofAddToRecent]);
|
|
irhPackageFiles : PackageEditingInterface.DoOpenPackageFile(FFileName,[pofAddToRecent],False);
|
|
end;
|
|
end;
|
|
|
|
{ TSearchItem }
|
|
|
|
procedure TSearchItem.SetSource(AValue: TObject);
|
|
begin
|
|
if FSource=AValue then Exit;
|
|
FSource:=AValue;
|
|
end;
|
|
|
|
constructor TSearchItem.Create(aSource: TObject; AOwnsSource: Boolean);
|
|
begin
|
|
FSource:=aSource;
|
|
FOwnsSource:=AOwnsSource;
|
|
end;
|
|
|
|
destructor TSearchItem.Destroy;
|
|
begin
|
|
if OwnsSource then
|
|
FreeAndNil(FSource);
|
|
Inherited;
|
|
end;
|
|
|
|
{ TIDEScoutForm }
|
|
|
|
procedure TIDEScoutForm.ECommandChange(Sender: TObject);
|
|
begin
|
|
FilterList(ESearch.Text);
|
|
end;
|
|
|
|
procedure TIDEScoutForm.ECommandKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
Case Key of
|
|
VK_ESCAPE: Hide;
|
|
VK_UP:
|
|
begin
|
|
If LBMatches.ItemIndex>0 then
|
|
LBMatches.ItemIndex:=LBMatches.ItemIndex-1;
|
|
Key:=0;
|
|
ESearch.SelStart:=Length(ESearch.Text);
|
|
end;
|
|
VK_DOWN:
|
|
begin
|
|
If LBMatches.ItemIndex<LBMatches.Items.Count-1 then
|
|
LBMatches.ItemIndex:=LBMatches.ItemIndex+1;
|
|
Key:=0;
|
|
ESearch.SelStart:=Length(ESearch.Text);
|
|
end;
|
|
VK_RETURN :
|
|
If LBMatches.ItemIndex>=0 then
|
|
ExecuteSelected;
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.ESearchButtonClick(Sender: TObject);
|
|
begin
|
|
LazarusIDE.DoOpenIDEOptions(SettingsClass,'IDE Scout');
|
|
Close;
|
|
end;
|
|
|
|
|
|
procedure TIDEScoutForm.FormActivate(Sender: TObject);
|
|
begin
|
|
ESearch.SetFocus;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.FormClose(Sender: TObject;
|
|
var CloseAction: TCloseAction);
|
|
begin
|
|
CloseAction:=caHide;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.RefreshCaption(aCount : Integer);
|
|
|
|
begin
|
|
if ACount=-1 then
|
|
Caption:=FOrgCaption+Format(' (%d)',[FSearchItems.Count])
|
|
else
|
|
Caption:=FOrgCaption+Format(' (%d/%d)',[aCount,FSearchItems.Count]);
|
|
end;
|
|
|
|
procedure TIDEScoutForm.FilterList(aSearchTerm: String);
|
|
|
|
Var
|
|
i : Integer;
|
|
Itm : TSearchItem;
|
|
Words : Array of string;
|
|
MatchPos : Array of Integer;
|
|
MatchLen : Array of Integer;
|
|
|
|
Function Match(S : String) : Boolean;
|
|
|
|
Var
|
|
I : integer;
|
|
|
|
begin
|
|
Result:=True;
|
|
I:=0;
|
|
While Result and (I<Length(Words)) do
|
|
begin
|
|
MatchPos[i]:=Pos(Words[i],S);
|
|
Result:=MatchPos[i]<>0;
|
|
inc(I);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if (ASearchTerm='') then
|
|
begin
|
|
LBMatches.Clear;
|
|
Exit;
|
|
end;
|
|
aSearchTerm:=LowerCase(aSearchTerm);
|
|
Setlength(Words,WordCount(aSearchTerm,[' ']));
|
|
Setlength(MatchPos,Length(Words));
|
|
Setlength(MatchLen,Length(Words));
|
|
For I:=1 to Length(Words) do
|
|
begin
|
|
Words[I-1]:=ExtractWord(I,aSearchTerm,[' ']);
|
|
MatchLen[I-1]:=Length(Words[I-1]);
|
|
end;
|
|
LBMatches.Items.BeginUpdate;
|
|
try
|
|
LBMatches.Items.Clear;
|
|
For I:=0 to FSearchItems.Count-1 do
|
|
if Match(FSearchItems[I]) then
|
|
begin
|
|
Itm:=FSearchItems.Objects[I] as TSearchItem;
|
|
Itm.MatchPos:=Copy(MatchPos,0,Length(MatchPos));
|
|
Itm.MatchLen:=Copy(MatchLen,0,Length(MatchLen));
|
|
LBMatches.Items.AddObject(FSearchItems[I],Itm);
|
|
end;
|
|
RefreshCaption(LBMatches.Items.Count);
|
|
finally
|
|
LBMatches.Items.EndUpdate;
|
|
LBMatches.Visible:=LBMatches.Items.Count>0;
|
|
If LBMatches.Visible then
|
|
LBMatches.ItemIndex:=0;
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.AddFileToList(aFileName: String; aType: TIDERecentHandler; CheckDuplicate : Boolean = False);
|
|
|
|
Var
|
|
F : TOpenFileItem;
|
|
SI : TSearchItem;
|
|
FN,Prefix : String;
|
|
|
|
begin
|
|
if ShowCategory then
|
|
Case aType of
|
|
irhPackageFiles : Prefix:='Package: ';
|
|
irhProjectFiles : Prefix:='Project: ';
|
|
irhOpenFiles : Prefix:='File: ';
|
|
end;
|
|
FN:=Prefix+aFileName;
|
|
if (Not CheckDuplicate) or (FSearchItems.IndexOf(FN)=-1) then
|
|
begin
|
|
F:=TOpenFileItem.Create(aFileName,aType);
|
|
SI:=TSearchItem.Create(F,True);
|
|
SI.Prefix:=Prefix;
|
|
FSearchItems.AddObject(FN,SI);
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TIDEScoutForm.FormCreate(Sender: TObject);
|
|
begin
|
|
FSearchItems:=TStringList.Create;
|
|
FSearchItems.OwnsObjects:=True;
|
|
Caption:=isrsIDEScout;
|
|
FOrgCaption:=Caption;
|
|
ESearch.TextHint:=isrsTypeSearchTerms;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.FormDestroy(Sender: TObject);
|
|
begin
|
|
With IDEEnvironmentOptions do
|
|
begin
|
|
RemoveHandlerAddToRecentOpenFiles(@PackageOpened);
|
|
RemoveHandlerAddToRecentProjectFiles(@FileOpened);
|
|
RemoveHandlerAddToRecentPackageFiles(@ProjectOpened);
|
|
end;
|
|
FreeAndNil(FSearchItems);
|
|
ScoutForm:=Nil;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.FormShow(Sender: TObject);
|
|
|
|
begin
|
|
ESearch.Clear;
|
|
LBMatches.Clear;
|
|
RefreshCaption(-1);
|
|
if FRefresh<>[] then
|
|
RefreshList;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.LBMatchesClick(Sender: TObject);
|
|
|
|
begin
|
|
ExecuteSelected;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.LBMatchesDrawItem(Control: TWinControl; Index: Integer;
|
|
ARect: TRect; State: TOwnerDrawState);
|
|
|
|
Const
|
|
LeftMargin = 5;
|
|
RightMargin = LeftMargin;
|
|
|
|
Var
|
|
LB : TListbox;
|
|
DS,S : String;
|
|
Itm : TSearchItem;
|
|
R : TRect;
|
|
P,I,SP,W : Integer;
|
|
FC : TColor;
|
|
|
|
begin
|
|
LB:=Control as TListBox;
|
|
LB.Canvas.FillRect(ARect);
|
|
FC:=LB.Canvas.Font.Color;
|
|
Itm:=LB.Items.Objects[Index] as TSearchItem;
|
|
S:=LB.Items[Index];
|
|
R:=ARect;
|
|
if ShowShortCutKey and (Itm.KeyStroke<>'') then
|
|
begin
|
|
W:=LB.Canvas.TextWidth(Itm.KeyStroke);
|
|
R.Right:=R.Right-W-RightMargin;
|
|
end;
|
|
Inc(R.Left,LeftMargin);
|
|
SP:=1;
|
|
For I:=0 to Length(Itm.MatchPos)-1 do
|
|
begin
|
|
P:=Itm.MatchPos[i];
|
|
if (P-SP>0) then
|
|
begin
|
|
DS:=Copy(S,SP,P-SP);
|
|
LB.Canvas.TextRect(R,R.Left,R.Top,DS);
|
|
Inc(R.Left,LB.Canvas.TextWidth(DS));
|
|
end;
|
|
DS:=Copy(S,P,Itm.MatchLen[i]);
|
|
LB.Canvas.Font.Color:=MatchColor;
|
|
LB.Canvas.TextRect(R,R.Left,R.Top,DS);
|
|
LB.Canvas.Font.Color:=FC;
|
|
Inc(R.Left,LB.Canvas.TextWidth(DS));
|
|
SP:=P+Itm.MatchLen[i];
|
|
end;
|
|
if SP<=Length(S) then
|
|
begin
|
|
DS:=Copy(S,SP,Length(S)-SP+1);
|
|
LB.Canvas.TextRect(R,R.Left,R.Top,DS);
|
|
end;
|
|
if Itm.KeyStroke<>'' then
|
|
begin
|
|
R.Left:=R.Right+1;
|
|
R.Right:=aRect.Right;
|
|
LB.Canvas.Font.Color:=KeyStrokeColor;
|
|
LB.Canvas.TextRect(R,R.Left,R.Top,Itm.KeyStroke);
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.ExecuteSelected;
|
|
|
|
Var
|
|
idx: Integer;
|
|
itm : TSearchItem;
|
|
|
|
begin
|
|
Idx:=LBMatches.ItemIndex;
|
|
if (Idx>=0) then
|
|
begin
|
|
Hide;
|
|
Itm:=LBMatches.Items.Objects[Idx] as TSearchItem;
|
|
if Itm.Source is TIDECommand then
|
|
TIDECommand(Itm.Source).Execute(SourceEditorManagerIntf.ActiveEditor)
|
|
else if Itm.Source is TComponentItem then
|
|
TComponentItem(Itm.Source).Execute
|
|
else if Itm.Source is TOpenFileItem then
|
|
TOpenFileItem(Itm.Source).Execute;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TIDEScoutForm.LBMatchesKeyUp(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
if Key=VK_ESCAPE then
|
|
Hide;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.FillRecent(aType : TIDERecentHandler);
|
|
|
|
Var
|
|
L : TStringList;
|
|
S : String;
|
|
|
|
begin
|
|
L:=TstringList.Create;
|
|
try
|
|
IDEEnvironmentOptions.GetRecentFiles(aType,L);
|
|
For S in L do
|
|
AddFileToList(S,aType,False);
|
|
finally
|
|
L.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.FillComponents;
|
|
|
|
Var
|
|
I : integer;
|
|
Prefix,CC : String;
|
|
RC : TRegisteredComponent;
|
|
SI : TSearchItem;
|
|
|
|
begin
|
|
For I:=0 to IDEComponentPalette.Comps.Count-1 do
|
|
begin
|
|
RC:=IDEComponentPalette.Comps[I];
|
|
if RC.CanBeCreatedInDesigner then
|
|
begin
|
|
CC:=RC.ComponentClass.ClassName+' ('+RC.GetUnitName+')';
|
|
Prefix:='Component: ';
|
|
SI:=TSearchItem.Create(TComponentItem.Create(RC),True);
|
|
SI.Prefix:=Prefix;
|
|
FSearchItems.AddObject(UTF8LowerCase(Prefix+CC),SI);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.ClearRefreshableItems;
|
|
|
|
Var
|
|
I : Integer;
|
|
Si : TSearchItem;
|
|
SH : Set of TIDERecentHandler;
|
|
|
|
begin
|
|
SH:=[];
|
|
if stRecentFiles in FRefresh then
|
|
Include(SH,irhOpenFiles);
|
|
if stRecentProjects in FRefresh then
|
|
Include(SH,irhProjectFiles);
|
|
if stRecentPackages in FRefresh then
|
|
Include(SH,irhPackageFiles);
|
|
I:=FSearchItems.Count-1;
|
|
While I>=0 do
|
|
begin
|
|
SI:=TSearchItem(FSearchItems.Objects[i]);
|
|
if (SI.Source is TOpenFileItem) then
|
|
if TOpenFileItem(SI.Source).Handler in SH then
|
|
FSearchItems.Delete(I);
|
|
Dec(I);
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.RefreshList;
|
|
|
|
begin
|
|
FSearchItems.Sorted:=False;
|
|
FSearchItems.BeginUpdate;
|
|
try
|
|
ClearRefreshableItems;
|
|
if stRecentFiles in FRefresh then
|
|
FillRecent(irhOpenFiles);
|
|
if stRecentProjects in FRefresh then
|
|
FillRecent(irhProjectFiles);
|
|
if stRecentPackages in FRefresh then
|
|
FillRecent(irhPackageFiles);
|
|
FRefresh:=[];
|
|
finally
|
|
FSearchItems.Sorted:=True;
|
|
FSearchItems.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.Initialize;
|
|
begin
|
|
FSearchItems.Sorted:=False;
|
|
FSearchItems.BeginUpdate;
|
|
try
|
|
FSearchItems.Clear;
|
|
if stCommands in Highlights then
|
|
FillCommands;
|
|
if stComponents in Highlights then
|
|
FillComponents;
|
|
if stRecentFiles in Highlights then
|
|
begin
|
|
IDEEnvironmentOptions.AddHandlerAddToRecentOpenFiles(@FileOpened,False);
|
|
FillRecent(irhOpenFiles);
|
|
end;
|
|
if stRecentProjects in Highlights then
|
|
begin
|
|
IDEEnvironmentOptions.AddHandlerAddToRecentProjectFiles(@ProjectOpened,False);
|
|
FillRecent(irhProjectFiles);
|
|
end;
|
|
if stRecentPackages in Highlights then
|
|
begin
|
|
IDEEnvironmentOptions.AddHandlerAddToRecentPackageFiles(@PackageOpened,False);
|
|
FillRecent(irhPackageFiles);
|
|
end;
|
|
finally
|
|
FSearchItems.Sorted:=True;
|
|
FSearchItems.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TIDEScoutForm.GetCommandCategoryString(Cmd: TIDECommand): String;
|
|
|
|
Const
|
|
Cmds = ' commands';
|
|
|
|
Var
|
|
Cat: TIDECommandCategory;
|
|
D : String;
|
|
P : Integer;
|
|
|
|
begin
|
|
Result:='';
|
|
If Not ShowCategory then
|
|
Exit;
|
|
Cat:=Cmd.Category;
|
|
While (Cat<>Nil) and (Cat.Parent<>Nil) do
|
|
Cat:=Cat.Parent;
|
|
If Cat<>Nil then
|
|
begin
|
|
D:=Cat.Description;
|
|
P:=Pos(' commands',D);
|
|
If (P>0) and (P=Length(D)-Length(Cmds)+1) then
|
|
D:=Copy(D,1,P-1);
|
|
Result:=D+': ';
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEScoutForm.PackageOpened(Sender: TObject; AFileName: string;
|
|
var AAllow: Boolean);
|
|
begin
|
|
Include(FRefresh,stRecentPackages);
|
|
end;
|
|
|
|
procedure TIDEScoutForm.FileOpened(Sender: TObject; AFileName: string;
|
|
var AAllow: Boolean);
|
|
begin
|
|
Include(FRefresh,stRecentFiles);
|
|
end;
|
|
|
|
procedure TIDEScoutForm.ProjectOpened(Sender: TObject; AFileName: string;
|
|
var AAllow: Boolean);
|
|
begin
|
|
Include(FRefresh,stRecentProjects);
|
|
end;
|
|
|
|
procedure TIDEScoutForm.FillCommands;
|
|
var
|
|
I, J: Integer;
|
|
Itm : TSearchItem;
|
|
Cmd : TIDECommand;
|
|
Ks,Pref : String;
|
|
|
|
begin
|
|
For I:=0 to IDECommandList.CategoryCount-1 do
|
|
for J:=0 to IDECommandList.Categories[I].Count-1 do
|
|
begin
|
|
if TObject(IDECommandList.Categories[I].Items[J]) is TIDECommand then
|
|
begin
|
|
Cmd:=TIDECommand(IDECommandList.Categories[I].Items[J]);
|
|
Pref:=GetCommandCategoryString(Cmd);
|
|
ks:='';
|
|
if Cmd.ShortcutA.Key1<>VK_UNKNOWN then
|
|
begin
|
|
ks:=' ('+KeyAndShiftStateToKeyString(Cmd.ShortcutA.Key1,Cmd.ShortcutA.Shift1);
|
|
if Cmd.ShortcutA.Key2<>VK_UNKNOWN then
|
|
ks:=Ks+', '+KeyAndShiftStateToKeyString(Cmd.ShortcutA.Key2,Cmd.ShortcutA.Shift2);
|
|
ks:=ks+')';
|
|
end;
|
|
Itm:=TSearchItem.Create(Cmd);
|
|
Itm.Prefix:=Pref;
|
|
Itm.KeyStroke:=Ks;
|
|
FSearchItems.AddObject(UTF8LowerCase(Pref+Cmd.LocalizedName),Itm);
|
|
end;
|
|
end;
|
|
RefreshCaption(-1);
|
|
end;
|
|
|
|
end.
|
|
|