mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-05 21:38:27 +02:00
IDE, IdeIntf: Add multi-word search for Object inspector. Refactor and reuse code. Issue #40270, patch by n7800.
This commit is contained in:
Juha
parent
becbb68a0d
commit
dc2902bd6e
@ -43,7 +43,7 @@ uses
|
||||
// IdeIntf
|
||||
IDEImagesIntf, IDEHelpIntf, ObjInspStrConsts,
|
||||
PropEdits, PropEditUtils, ComponentTreeView, OIFavoriteProperties,
|
||||
ComponentEditors, ChangeParentDlg;
|
||||
ComponentEditors, ChangeParentDlg, TextTools;
|
||||
|
||||
const
|
||||
OIOptionsFileVersion = 3;
|
||||
@ -707,6 +707,9 @@ type
|
||||
FLastTreeSize: TRect;
|
||||
|
||||
// These event handlers are assigned at run-time, no need for default published section.
|
||||
function CompFilterEditFilterItemEx(const ACaption: string; ItemData: Pointer;
|
||||
out Done: Boolean): Boolean;
|
||||
procedure CompFilterEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure ComponentTreeDblClick(Sender: TObject);
|
||||
procedure ComponentTreeGetNodeImageIndex(APersistent: TPersistent; var AIndex: integer);
|
||||
procedure ComponentTreeKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
@ -740,6 +743,7 @@ type
|
||||
procedure WidgetSetRestrictedPaint(Sender: TObject);
|
||||
procedure ComponentRestrictedPaint(Sender: TObject);
|
||||
procedure PropFilterEditAfterFilter(Sender: TObject);
|
||||
procedure PropFilterEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure NoteBookPageChange(Sender: TObject);
|
||||
procedure ChangeParentItemClick(Sender: TObject);
|
||||
procedure CollectionAddItem(Sender: TObject);
|
||||
@ -2567,15 +2571,21 @@ var
|
||||
end;
|
||||
|
||||
procedure HandleUnshifted;
|
||||
const
|
||||
Page = 20;
|
||||
begin
|
||||
Handled := true;
|
||||
case Key of
|
||||
VK_UP : SetItemIndexAndFocus(ItemIndex - 1);
|
||||
VK_DOWN : SetItemIndexAndFocus(ItemIndex + 1);
|
||||
VK_PRIOR: SetItemIndexAndFocus(Max(ItemIndex - Page, 0));
|
||||
VK_NEXT : SetItemIndexAndFocus(Min(ItemIndex + Page, FRows.Count - 1));
|
||||
VK_PRIOR:
|
||||
if (RowCount > 0) and (RowRect(0).Height > 0) then
|
||||
SetItemIndexAndFocus(
|
||||
Max(ItemIndex - (Height div RowRect(0).Height - 2), 0) // "-2" to little less than a page
|
||||
);
|
||||
VK_NEXT :
|
||||
if (RowCount > 0) and (RowRect(0).Height > 0) then
|
||||
SetItemIndexAndFocus(
|
||||
Min(ItemIndex + (Height div RowRect(0).Height - 2), FRows.Count - 1) // "-2" to little less than a page
|
||||
);
|
||||
|
||||
VK_TAB: DoTabKey;
|
||||
|
||||
@ -4402,6 +4412,8 @@ begin
|
||||
ComponentPanel.Constraints.MinHeight := 8;
|
||||
ComponentPanel.Visible := FShowComponentTree;
|
||||
CompFilterEdit.FilteredTreeview := ComponentTree;
|
||||
CompFilterEdit.OnFilterItemEx := @CompFilterEditFilterItemEx;
|
||||
CompFilterEdit.OnKeyDown := @CompFilterEditKeyDown;
|
||||
|
||||
InfoPanel := TPanel.Create(Self);
|
||||
with InfoPanel do
|
||||
@ -4474,6 +4486,7 @@ begin
|
||||
Anchors := [akTop, akLeft, akRight];
|
||||
BorderSpacing.Left := 5;
|
||||
OnAfterFilter := @PropFilterEditAfterFilter;
|
||||
OnKeyDown := @PropFilterEditKeyDown;
|
||||
end;
|
||||
|
||||
CreateNoteBook;
|
||||
@ -4503,6 +4516,15 @@ begin
|
||||
FPropFilterUpdating := False;
|
||||
end;
|
||||
|
||||
procedure TObjectInspectorDlg.PropFilterEditKeyDown(Sender: TObject;
|
||||
var Key: Word; Shift: TShiftState);
|
||||
var
|
||||
c: char;
|
||||
begin
|
||||
if KeyToQWERTY(Key, Shift, c, true) then
|
||||
PropFilterEdit.SelText := c;
|
||||
end;
|
||||
|
||||
procedure TObjectInspectorDlg.NoteBookPageChange(Sender: TObject);
|
||||
begin
|
||||
PropFilterEditAfterFilter(Sender);
|
||||
@ -4989,6 +5011,22 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TObjectInspectorDlg.CompFilterEditFilterItemEx(const ACaption: string;
|
||||
ItemData: Pointer; out Done: Boolean): Boolean;
|
||||
begin
|
||||
Done := true;
|
||||
result := MultiWordSearch(CompFilterEdit.Text, ACaption);
|
||||
end;
|
||||
|
||||
procedure TObjectInspectorDlg.CompFilterEditKeyDown(Sender: TObject;
|
||||
var Key: Word; Shift: TShiftState);
|
||||
var
|
||||
c: char;
|
||||
begin
|
||||
if KeyToQWERTY(Key, Shift, c, true) then
|
||||
CompFilterEdit.SelText := c;
|
||||
end;
|
||||
|
||||
function TObjectInspectorDlg.GetComponentEditorForSelection: TBaseComponentEditor;
|
||||
var
|
||||
APersistent: TPersistent;
|
||||
|
||||
@ -35,7 +35,7 @@ uses
|
||||
FileUtil, StringHashList, LazMethodList, LazLoggerBase, LazUtilities, LazStringUtils,
|
||||
GraphType, UITypes, FPCAdds, // for StrToQWord in older fpc versions
|
||||
// IdeIntf
|
||||
ObjInspStrConsts, PropEditUtils,
|
||||
ObjInspStrConsts, PropEditUtils, TextTools,
|
||||
// Forms with .lfm files
|
||||
FrmSelectProps, StringsPropEditDlg, KeyValPropEditDlg, CollectionPropEditForm,
|
||||
FileFilterPropEditor, PagesPropEditDlg, IDEWindowIntf;
|
||||
@ -7727,7 +7727,7 @@ var
|
||||
with GetTypeData(EnumType)^ do
|
||||
for i := MinValue to MaxValue do
|
||||
begin
|
||||
Result := PosI(APropNameFilter, GetEnumName(EnumType,i)) > 0;
|
||||
Result := MultiWordSearch(APropNameFilter, GetEnumName(EnumType,i));
|
||||
if Result then
|
||||
Break;
|
||||
end;
|
||||
@ -7754,7 +7754,8 @@ var
|
||||
begin
|
||||
propInfo := propList^[i];
|
||||
|
||||
Result := PosI(APropNameFilter, propInfo^.Name) > 0;
|
||||
Result := MultiWordSearch(APropNameFilter, propInfo^.Name);
|
||||
|
||||
if Result then break;
|
||||
//if encounter a Set check its elements name.
|
||||
if (propInfo^.PropType^.Kind = tkSet) then
|
||||
@ -7794,7 +7795,9 @@ var
|
||||
begin
|
||||
if (APropNameFilter = '') or AForceShow then
|
||||
exit;
|
||||
Result := PosI(APropNameFilter, A.GetName) > 0; // Check single Props
|
||||
|
||||
Result := MultiWordSearch(APropNameFilter, A.GetName); // Check single Props
|
||||
|
||||
// Check if check Set has element.
|
||||
if (ti^.Kind = tkSet) and (A.ClassType <> TSetElementPropertyEditor) then
|
||||
Result := Result or IsPropInSet(A.GetPropType);
|
||||
@ -7802,10 +7805,10 @@ var
|
||||
exit;
|
||||
end;
|
||||
|
||||
// Subroperties can change if user selects another object =>
|
||||
// Subproperties can change if user selects another object =>
|
||||
// we must show the property, even if it is not interesting currently.
|
||||
Result := paVolatileSubProperties in A.GetAttributes;
|
||||
if Result then exit;
|
||||
//Result := paVolatileSubProperties in A.GetAttributes; // Not really needed?
|
||||
//if Result then exit;
|
||||
|
||||
if tkClass in AFilter then
|
||||
begin
|
||||
@ -7816,7 +7819,9 @@ var
|
||||
// if no SubProperties check against filter name
|
||||
if (APropNameFilter = '') then
|
||||
exit;
|
||||
Result := PosI(APropNameFilter, A.GetName) > 0;
|
||||
|
||||
Result := MultiWordSearch(APropNameFilter, A.GetName);
|
||||
|
||||
if (paSubProperties in A.GetAttributes) then
|
||||
Result := Result or IsPropInClass(A.GetPropType);
|
||||
|
||||
@ -7848,7 +7853,7 @@ var
|
||||
ed.SetPropEntry(0, obj, propList^[i]);
|
||||
ed.Initialize;
|
||||
// filter TClassPropertyEditor name recursively
|
||||
Rec(ed, PosI(APropNameFilter, A.GetName) > 0 );
|
||||
Rec(ed, MultiWordSearch(APropNameFilter, A.GetName));
|
||||
finally
|
||||
ed.Free;
|
||||
end;
|
||||
|
||||
@ -17,6 +17,8 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
// LCL
|
||||
LCLType,
|
||||
// LazUtils
|
||||
UITypes;
|
||||
|
||||
@ -83,7 +85,9 @@ procedure RESplit(const TheText, SeparatorRegExpr: string; Pieces: TStrings;
|
||||
function GetPathElement(const Path: string; StartPos: integer;
|
||||
Stopper: char): string;
|
||||
|
||||
|
||||
// For searching and filtering items in different lists.
|
||||
function MultiWordSearch(aFilter, aText: string): boolean;
|
||||
function KeyToQWERTY(var Key: Word; Shift: TShiftState; out aChar: char; aLowerCase: boolean = false): boolean;
|
||||
|
||||
|
||||
//------------------------------------------------------------------------------
|
||||
@ -162,5 +166,83 @@ begin
|
||||
Result:=copy(Path,StartPos,p-StartPos);
|
||||
end;
|
||||
|
||||
function MultiWordSearch(aFilter, aText: string): boolean;
|
||||
var
|
||||
lExpressions: TStringList;
|
||||
i: Integer;
|
||||
|
||||
function FilterByExpression(AFilter: string): boolean;
|
||||
var
|
||||
lConditions: TStringList;
|
||||
i: Integer;
|
||||
begin
|
||||
lConditions := TStringList.Create;
|
||||
try
|
||||
lConditions.QuoteChar := #0;
|
||||
lConditions.AddDelimitedText(AFilter, ' ', true);
|
||||
for i := 0 to lConditions.Count - 1 do
|
||||
if lConditions[i] <> '' then
|
||||
begin
|
||||
if lConditions[i][1] = '!' then
|
||||
begin
|
||||
lConditions[i] := RightStr(lConditions[i], length(lConditions[i]) - 1); // delete "!"
|
||||
if Pos(lConditions[i], aText) > 0 then
|
||||
exit(true);
|
||||
end else begin
|
||||
if Pos(lConditions[i], aText) <= 0 then
|
||||
exit(true);
|
||||
end;
|
||||
end;
|
||||
Result := false;
|
||||
finally
|
||||
FreeAndNil(lConditions);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
if aFilter = '' then exit(true);
|
||||
aText := '"' + lowercase(aText) + '"';
|
||||
aFilter := lowercase(aFilter);
|
||||
|
||||
lExpressions := TStringList.Create;
|
||||
try
|
||||
lExpressions.QuoteChar := #0;
|
||||
lExpressions.AddDelimitedText(aFilter, ',', true);
|
||||
for i := 0 to lExpressions.Count - 1 do
|
||||
if lExpressions[i] <> '' then
|
||||
if not FilterByExpression(lExpressions[i]) then
|
||||
exit(true);
|
||||
result := false;
|
||||
finally
|
||||
FreeAndNil(lExpressions);
|
||||
end;
|
||||
end;
|
||||
|
||||
function KeyToQWERTY(var Key: Word; Shift: TShiftState; out aChar: char; aLowerCase: boolean = false): boolean;
|
||||
begin
|
||||
aChar := #0;
|
||||
|
||||
if Shift = [] then
|
||||
case Key of
|
||||
VK_A..VK_Z: aChar := chr(Key + $20); // VK-codes matches ASCII chars
|
||||
VK_LCL_COMMA: aChar := ',';
|
||||
VK_OEM_PERIOD: aChar := '.';
|
||||
end
|
||||
else if Shift = [ssShift] then
|
||||
case Key of
|
||||
VK_A..VK_Z:
|
||||
if aLowerCase
|
||||
then aChar := chr(Key + $20) // VK-codes matches ASCII chars
|
||||
else aChar := chr(Key);
|
||||
VK_LCL_MINUS: aChar := '_';
|
||||
VK_1 : aChar := '!';
|
||||
VK_LCL_QUOTE: aChar := '"';
|
||||
end;
|
||||
|
||||
result := aChar <> #0;
|
||||
if result then
|
||||
Key := 0;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -42,6 +42,7 @@ uses
|
||||
TreeFilterEdit,
|
||||
// IdeIntf
|
||||
FormEditingIntf, IDEImagesIntf, PropEdits, MenuIntf, ComponentReg, LazIDEIntf,
|
||||
TextTools,
|
||||
// IDE
|
||||
LazarusIDEStrConsts, PackageDefs, IDEOptionDefs, EnvironmentOpts, Designer;
|
||||
|
||||
@ -634,97 +635,18 @@ end;
|
||||
|
||||
function TComponentListForm.TreeFilterEdFilterItemEx(const ACaption: string;
|
||||
ItemData: Pointer; out Done: Boolean): Boolean;
|
||||
var
|
||||
lExpressions: TStringList;
|
||||
i: Integer;
|
||||
lCaption: string;
|
||||
|
||||
function FilterByExpression(AFilter: string): boolean;
|
||||
var
|
||||
lConditions: TStringList;
|
||||
i: Integer;
|
||||
begin
|
||||
lConditions := TStringList.Create;
|
||||
try
|
||||
lConditions.QuoteChar := #0;
|
||||
lConditions.AddDelimitedText(AFilter, ' ', true);
|
||||
for i := 0 to lConditions.Count - 1 do
|
||||
if lConditions[i] <> '' then
|
||||
begin
|
||||
if lConditions[i][1] = '!' then
|
||||
begin
|
||||
lConditions[i] := RightStr(lConditions[i], length(lConditions[i]) - 1); // delete "!"
|
||||
if Pos(lConditions[i], lCaption) > 0 then
|
||||
exit(true);
|
||||
end else begin
|
||||
if Pos(lConditions[i], lCaption) <= 0 then
|
||||
exit(true);
|
||||
end;
|
||||
end;
|
||||
Result := false;
|
||||
finally
|
||||
FreeAndNil(lConditions);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Done := true;
|
||||
if TreeFilterEd.Text = '' then exit(true);
|
||||
lCaption := '"' + lowercase(ACaption) + '"';
|
||||
|
||||
lExpressions := TStringList.Create;
|
||||
try
|
||||
lExpressions.QuoteChar := #0;
|
||||
lExpressions.AddDelimitedText(TreeFilterEd.Text, ',', true); // TreeFilterEd.Text always lowercase
|
||||
for i := 0 to lExpressions.Count - 1 do
|
||||
if lExpressions[i] <> '' then
|
||||
if not FilterByExpression(lExpressions[i]) then
|
||||
exit(true);
|
||||
result := false;
|
||||
finally
|
||||
FreeAndNil(lExpressions);
|
||||
end;
|
||||
result := MultiWordSearch(TreeFilterEd.Text, ACaption);
|
||||
end;
|
||||
|
||||
procedure TComponentListForm.TreeFilterEdKeyDown(Sender: TObject;
|
||||
var Key: Word; Shift: TShiftState);
|
||||
var
|
||||
c: char;
|
||||
begin
|
||||
|
||||
if (Key in [VK_A..VK_Z]) and ((Shift = []) or (Shift = [ssShift])) then
|
||||
begin
|
||||
TreeFilterEd.SelText := chr(Key + $20); // VK-codes matches ASCII chars
|
||||
Key := 0;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if (Key = VK_1) and (Shift = [ssShift]) then
|
||||
begin
|
||||
TreeFilterEd.SelText := '!';
|
||||
Key := 0;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if (Key = VK_LCL_QUOTE) and (Shift = [ssShift]) then
|
||||
begin
|
||||
TreeFilterEd.SelText := '"';
|
||||
Key := 0;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if (Key = VK_LCL_COMMA) and (Shift = []) then
|
||||
begin
|
||||
TreeFilterEd.SelText := ',';
|
||||
Key := 0;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if (Key = VK_LCL_MINUS) and (Shift = [ssShift]) then
|
||||
begin
|
||||
TreeFilterEd.SelText := '_';
|
||||
Key := 0;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if KeyToQWERTY(Key, Shift, c) then
|
||||
TreeFilterEd.SelText := c;
|
||||
end;
|
||||
|
||||
procedure TComponentListForm.tmDeselectTimer(Sender: TObject);
|
||||
|
||||
@ -47,7 +47,7 @@ uses
|
||||
// Codetools
|
||||
CodeTree, CodeToolManager, CodeCache, PascalParserTool, KeywordFuncLists,
|
||||
// IDEIntf
|
||||
LazIDEIntf, IDEImagesIntf, SrcEditorIntf, IDEWindowIntf,
|
||||
LazIDEIntf, IDEImagesIntf, SrcEditorIntf, IDEWindowIntf, TextTools,
|
||||
// IDE
|
||||
EnvironmentOpts, LazarusIDEStrConsts;
|
||||
|
||||
@ -281,26 +281,11 @@ begin
|
||||
end;
|
||||
|
||||
procedure TProcedureListForm.edMethodsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
var
|
||||
c: char;
|
||||
begin
|
||||
|
||||
if (Shift = []) and (Key in [VK_A..VK_Z]) then
|
||||
begin
|
||||
edMethods.SelText := chr(Key + $20); // VK-codes matches ASCII chars
|
||||
Key := 0;
|
||||
end;
|
||||
|
||||
if (Shift = [ssShift]) and (Key in [VK_A..VK_Z]) then
|
||||
begin
|
||||
edMethods.SelText := chr(Key); // VK-codes matches ASCII chars
|
||||
Key := 0;
|
||||
end;
|
||||
|
||||
if (Shift = []) and (Key = VK_OEM_PERIOD) then
|
||||
begin
|
||||
edMethods.SelText := '.';
|
||||
Key := 0;
|
||||
end;
|
||||
|
||||
if KeyToQWERTY(Key, Shift, c) then
|
||||
edMethods.SelText := c;
|
||||
end;
|
||||
|
||||
procedure TProcedureListForm.FormDestroy(Sender: TObject);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user