paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 20:59:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

Examples window: Improve the filter and prevent an AV etc. Issue #40034, patch by dbannon.

Browse Source
This commit is contained in:
Juha 2022-12-06 20:40:40 +02:00
parent df2ee9de4f
commit 32963dc9d5
2 changed files with 91 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
components/exampleswindow/ulaz_examples.lfm
View File

@ -1,14 +1,16 @@
object FormLazExam: TFormLazExam object FormLazExam: TFormLazExam
Left = 88 Left = 457
Height = 400 Height = 400
Top = 155 Top = 318
Width = 781 Width = 781
Caption = 'Prototype Lazarus Examples Window' Caption = 'Prototype Lazarus Examples Window'
ClientHeight = 400 ClientHeight = 400
ClientWidth = 781 ClientWidth = 781
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
OnKeyDown = FormKeyDown
OnShow = FormShow OnShow = FormShow
Position = poWorkAreaCenter
LCLVersion = '2.3.0.0' LCLVersion = '2.3.0.0'
object Memo1: TMemo object Memo1: TMemo
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
@ -28,10 +30,11 @@ object FormLazExam: TFormLazExam
Lines.Strings = ( Lines.Strings = (
'Memo1' 'Memo1'
) )
OnKeyDown = FormKeyDown
ParentShowHint = False ParentShowHint = False
ReadOnly = True ReadOnly = True
ScrollBars = ssAutoVertical ScrollBars = ssAutoVertical
TabOrder = 1 TabOrder = 2
TabStop = False TabStop = False
end end
object ListView1: TListView object ListView1: TListView
@ -46,6 +49,7 @@ object FormLazExam: TFormLazExam
Top = 37 Top = 37
Width = 771 Width = 771
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
AutoSort = False
BorderSpacing.Around = 5 BorderSpacing.Around = 5
Columns = < Columns = <
item item
@ -63,6 +67,8 @@ object FormLazExam: TFormLazExam
TabOrder = 0 TabOrder = 0
OnClick = ListView1Click OnClick = ListView1Click
OnDblClick = ListView1DblClick OnDblClick = ListView1DblClick
OnEnter = ListView1Enter
OnExit = ListView1Exit
OnKeyDown = ListView1KeyDown OnKeyDown = ListView1KeyDown
OnSelectItem = ListView1SelectItem OnSelectItem = ListView1SelectItem
end end
@ -95,7 +101,7 @@ object FormLazExam: TFormLazExam
OnItemClick = CheckGroupCategoryItemClick OnItemClick = CheckGroupCategoryItemClick
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
TabOrder = 2 TabOrder = 3
end end
object Splitter2: TSplitter object Splitter2: TSplitter
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
@ -120,8 +126,7 @@ object FormLazExam: TFormLazExam
Panels = <> Panels = <>
end end
object ButtonDownload: TButton object ButtonDownload: TButton
AnchorSideLeft.Control = ButtonOpen AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonOpen AnchorSideBottom.Control = ButtonOpen
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
@ -134,7 +139,7 @@ object FormLazExam: TFormLazExam
BorderSpacing.Left = 5 BorderSpacing.Left = 5
Caption = 'Download' Caption = 'Download'
OnClick = ButtonDownloadClick OnClick = ButtonDownloadClick
TabOrder = 5 TabOrder = 6
end end
object ButtonClose: TButton object ButtonClose: TButton
AnchorSideLeft.Control = ButtonView AnchorSideLeft.Control = ButtonView
@ -150,11 +155,13 @@ object FormLazExam: TFormLazExam
AutoSize = True AutoSize = True
BorderSpacing.Left = 5 BorderSpacing.Left = 5
Caption = 'Close' Caption = 'Close'
ModalResult = 11
OnClick = ButtonCloseClick OnClick = ButtonCloseClick
TabOrder = 6 TabOrder = 9
end end
object ButtonOpen: TButton object ButtonOpen: TButton
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = ButtonDownload
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = StatusBar1 AnchorSideBottom.Control = StatusBar1
Left = 5 Left = 5
@ -170,7 +177,7 @@ object FormLazExam: TFormLazExam
TabOrder = 7 TabOrder = 7
end end
object ButtonView: TButton object ButtonView: TButton
AnchorSideLeft.Control = ButtonDownload AnchorSideLeft.Control = ButtonOpen
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonOpen AnchorSideBottom.Control = ButtonOpen
@ -201,11 +208,9 @@ object FormLazExam: TFormLazExam
BorderSpacing.Top = 5 BorderSpacing.Top = 5
BorderSpacing.Right = 5 BorderSpacing.Right = 5
OnChange = EditSearchChange OnChange = EditSearchChange
OnExit = EditSearchExit OnKeyDown = EditSearchKeyDown
OnKeyUp = EditSearchKeyUp
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
TabOrder = 9 TabOrder = 1
Text = 'EditSearch'
end end
end end

117
components/exampleswindow/ulaz_examples.pas
View File

@ -18,14 +18,10 @@ In either case will scan the LazConfigDir (excluding Examples ???) looking for
potential 'other' example projects, recognisable by a valid json file with an potential 'other' example projects, recognisable by a valid json file with an
extension of ex-meta. extension of ex-meta.
Notes - David Bannon, Dec 2022
We have a search field across the top, its requires user to press enter,
performance notwithstanding, it could be converted to update with every key press.
David Bannon, Feb 2022
} }
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{.$define EXTESTMODE} {$define EXTESTMODE}
{X$define ONLINE_EXAMPLES} {X$define ONLINE_EXAMPLES}
@ -43,7 +39,6 @@ uses
{$endif} {$endif}
uexampledata, uConst; uexampledata, uConst;
type type
{ TFormLazExam } { TFormLazExam }
@ -66,16 +61,19 @@ type
procedure CheckGroupCategoryDblClick(Sender: TObject); procedure CheckGroupCategoryDblClick(Sender: TObject);
procedure CheckGroupCategoryItemClick(Sender: TObject; {%H-}Index: integer); procedure CheckGroupCategoryItemClick(Sender: TObject; {%H-}Index: integer);
procedure EditSearchChange(Sender: TObject); procedure EditSearchChange(Sender: TObject);
procedure EditSearchExit(Sender: TObject); procedure EditSearchKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure EditSearchKeyUp(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure ListView1Click(Sender: TObject); procedure ListView1Click(Sender: TObject);
procedure ListView1DblClick(Sender: TObject); procedure ListView1DblClick(Sender: TObject);
procedure ListView1Enter(Sender: TObject);
procedure ListView1Exit(Sender: TObject);
procedure ListView1KeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState); procedure ListView1KeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure ListView1SelectItem(Sender: TObject; {%H-}Item: TListItem; {%H-}Selected: Boolean); procedure ListView1SelectItem(Sender: TObject; {%H-}Item: TListItem; {%H-}Selected: Boolean);
private private
LastListViewIndex : integer; // If 0 or greater, its an index to ListView
procedure BuildSearchList(SL: TStringList; const Term: AnsiString); procedure BuildSearchList(SL: TStringList; const Term: AnsiString);
// Copies the passed ex dir to a dir named for the Proj. // Copies the passed ex dir to a dir named for the Proj.
// SrcDir includes name of actual dir, DestDir does not. // SrcDir includes name of actual dir, DestDir does not.
@ -90,8 +88,7 @@ type
// Thats triggers a Lazarus Open when this window closes. // Thats triggers a Lazarus Open when this window closes.
function GetProjectFile(const APath: string; WriteProjectToOpen: boolean = false): boolean; function GetProjectFile(const APath: string; WriteProjectToOpen: boolean = false): boolean;
procedure KeyWordSearch; procedure KeyWordSearch;
function NewLVItem(const LView: TListView; const Proj, Path, KeyWords, procedure NewLVItem(const Proj, Path, KeyWords, Cat: string);
Cat: string): TListItem;
// Displays the current content of Examples List in the listview and // Displays the current content of Examples List in the listview and
// populates the Category checkboxes. // populates the Category checkboxes.
procedure LoadUpListView(); procedure LoadUpListView();
@ -117,16 +114,15 @@ implementation
// ------------------------ L I S T V I E W ---------------------------------- // ------------------------ L I S T V I E W ----------------------------------
function TFormLazExam.NewLVItem(const LView : TListView; const Proj, Path, KeyWords, Cat : string): TListItem; procedure TFormLazExam.NewLVItem(const Proj, Path, KeyWords, Cat : string);
var var
TheItem : TListItem; TheItem : TListItem;
begin begin
TheItem := LView.Items.Add; TheItem := ListView1.Items.Add;
TheItem.Caption := Proj; TheItem.Caption := Proj;
TheItem.SubItems.Add(KeyWords); TheItem.SubItems.Add(KeyWords);
TheItem.SubItems.Add(Path); TheItem.SubItems.Add(Path);
TheItem.SubItems.Add(Cat); TheItem.SubItems.Add(Cat);
Result := TheItem;
end; end;
procedure TFormLazExam.ListView1SelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); procedure TFormLazExam.ListView1SelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
@ -147,15 +143,15 @@ begin
end; end;
try try
if Ex.GetListData(Proj, Cat, Path, KeyW, True, KeyList) then begin if Ex.GetListData(Proj, Cat, Path, KeyW, True, KeyList) then begin
NewLVItem(ListView1, Proj, Path, KeyW, Cat); NewLVItem(Proj, Path, KeyW, Cat);
inc(Cnt); inc(Cnt);
end; end;
while Ex.GetListData(Proj, Cat, Path, KeyW, False, KeyList) do begin while Ex.GetListData(Proj, Cat, Path, KeyW, False, KeyList) do begin
NewLVItem(ListView1, Proj, Path, KeyW, Cat); NewLVItem(Proj, Path, KeyW, Cat);
inc(Cnt); inc(Cnt);
end; end;
finally finally
if KeyList <> Nil then KeyList.Free; KeyList.Free;
Screen.Cursor := crDefault; Screen.Cursor := crDefault;
end; end;
ButtonOpen.Enabled := false; ButtonOpen.Enabled := false;
@ -163,6 +159,7 @@ begin
ButtonView.enabled := false; ButtonView.enabled := false;
Memo1.append(format(rsFoundExampleProjects, [Cnt])); Memo1.append(format(rsFoundExampleProjects, [Cnt]));
StatusBar1.SimpleText := format(rsFoundExampleProjects, [Cnt]); StatusBar1.SimpleText := format(rsFoundExampleProjects, [Cnt]);
LastListViewIndex := -1; // start afresh
end; end;
procedure TFormLazExam.ListView1Click(Sender: TObject); procedure TFormLazExam.ListView1Click(Sender: TObject);
@ -179,26 +176,50 @@ begin
ButtonOpen.Enabled := GetProjectFile(Ex.ExampleWorkingDir() + ListView1.Selected.Caption); ButtonOpen.Enabled := GetProjectFile(Ex.ExampleWorkingDir() + ListView1.Selected.Caption);
end; end;
procedure TFormLazExam.ListView1DblClick(Sender: TObject); procedure TFormLazExam.ListView1DblClick(Sender: TObject);
// A doubleclick will select that row, but it happens after OnEnter.
begin begin
if ListView1.Selected = Nil then exit
else
LastListViewIndex := ListView1.ItemIndex; // So other methods can find user choice
ButtonDownloadClick(self); ButtonDownloadClick(self);
ButtonOpenClick(self); ButtonOpenClick(self);
end; end;
procedure TFormLazExam.ListView1Enter(Sender: TObject);
begin
ListView1.ItemIndex := LastListViewIndex; // possibly -1, half highlight item 0
end;
procedure TFormLazExam.ListView1Exit(Sender: TObject);
begin
LastListViewIndex := ListView1.ItemIndex; // save it before we leave, we'll be back
ListView1.ClearSelection;
ListView1.ItemIndex := -1;
end;
procedure TFormLazExam.ListView1KeyDown(Sender: TObject; var Key: Word; procedure TFormLazExam.ListView1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
begin begin
if Key = vk_return then begin if Key = VK_RETURN then begin
Key := 0; Key := 0;
// Its possible we tabbed into ListView without "selecting" a row.
if ListView1.ItemIndex < 0 then // I don't think this can happen anymore ?
if ListView1.Items.count > 0 then
ListView1.ItemIndex := 0 // Force select first item, its half highlite ??
else exit;
ListView1DblClick(Sender); ListView1DblClick(Sender);
end; end
else if Key = VK_ESCAPE then
ModalResult := mrClose;
end; end;
// --------------------- B U T T O N S ----------------------------------------- // --------------------- B U T T O N S -----------------------------------------
procedure TFormLazExam.ButtonOpenClick(Sender: TObject); procedure TFormLazExam.ButtonOpenClick(Sender: TObject);
begin begin
if LastListViewIndex < 0 then exit;
ListView1.ItemIndex:= LastListViewIndex;
if GetProjectFile(Ex.ExampleWorkingDir() + ListView1.Selected.Caption, True) // Sets ProjectToOpen on success if GetProjectFile(Ex.ExampleWorkingDir() + ListView1.Selected.Caption, True) // Sets ProjectToOpen on success
and ProjectToOpen.IsEmpty then and ProjectToOpen.IsEmpty then
showmessage(rsExNoProjectFile) showmessage(rsExNoProjectFile)
@ -208,7 +229,9 @@ end;
procedure TFormLazExam.ButtonDownloadClick(Sender: TObject); procedure TFormLazExam.ButtonDownloadClick(Sender: TObject);
begin begin
if ListView1.Selected = nil then exit; // White space below entries .... if LastListViewIndex < 0 then exit; // Can that happen ?
ListView1.ItemIndex:= LastListViewIndex;
if GetProjectFile(Ex.ExampleWorkingDir() + ListView1.Selected.Caption) then begin if GetProjectFile(Ex.ExampleWorkingDir() + ListView1.Selected.Caption) then begin
if Application.MessageBox(pchar(rsRefreshExistingExample) if Application.MessageBox(pchar(rsRefreshExistingExample)
, pchar(ListView1.Selected.Caption) , pchar(ListView1.Selected.Caption)
@ -238,12 +261,17 @@ begin
Screen.Cursor := crDefault; Screen.Cursor := crDefault;
end; end;
ButtonOpen.Enabled := GetProjectFile(Ex.ExampleWorkingDir() + ListView1.Selected.Caption); ButtonOpen.Enabled := GetProjectFile(Ex.ExampleWorkingDir() + ListView1.Selected.Caption);
ListView1.ItemIndex := -1; // Unselect again for the Tabbers of this world.
end; end;
procedure TFormLazExam.ButtonViewClick(Sender: TObject); procedure TFormLazExam.ButtonViewClick(Sender: TObject);
begin begin
// When we get here, we will have left the ListView and therefore triggered its onExit
// Must restore its selected before we access it !
if LastListViewIndex < 0 then exit; // lets not be silly
ListView1.ItemIndex:= LastListViewIndex;
OpenURL(BaseURL + ListView1.Selected.SubItems[2] + '/' + ListView1.Selected.Caption); OpenURL(BaseURL + ListView1.Selected.SubItems[2] + '/' + ListView1.Selected.Caption);
ListView1.ItemIndex := -1;
end; end;
procedure TFormLazExam.ButtonCloseClick(Sender: TObject); procedure TFormLazExam.ButtonCloseClick(Sender: TObject);
@ -375,16 +403,6 @@ begin
SL.Add(AWord); SL.Add(AWord);
end; end;
procedure TFormLazExam.EditSearchExit(Sender: TObject);
begin
if EditSearch.Text = '' then begin
EditSearch.Hint:= rsExSearchPrompt;
EditSearch.Text := rsExSearchPrompt;
EditSearch.SelStart := 1;
EditSearch.SelLength := length(EditSearch.Text);
end;
end;
procedure TFormLazExam.KeyWordSearch(); procedure TFormLazExam.KeyWordSearch();
begin begin
Memo1.clear; Memo1.clear;
@ -395,17 +413,19 @@ end;
procedure TFormLazExam.EditSearchChange(Sender: TObject); procedure TFormLazExam.EditSearchChange(Sender: TObject);
begin begin
if (EditSearch.Text <> '') and (EditSearch.Text <> rsExSearchPrompt) then if visible then KeyWordSearch();
KeyWordSearch();
end; end;
procedure TFormLazExam.EditSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure TFormLazExam.EditSearchKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin begin
// Must do this here to stop LCL from selecting the text on VK_RETURN
if Key = VK_RETURN then begin if Key = VK_RETURN then begin
Key := 0; key := 0;
KeyWordSearch(); if ListView1.items.Count > 0 then
end; ListView1.SetFocus;
end
else if Key = VK_ESCAPE then
ModalResult := mrClose;
end; end;
procedure TFormLazExam.PrimeCatFilter(); procedure TFormLazExam.PrimeCatFilter();
@ -439,7 +459,9 @@ begin
ListView1.Column[1].AutoSize := true; ListView1.Column[1].AutoSize := true;
ListView1.Column[2].Visible := false; ListView1.Column[2].Visible := false;
ListView1.ReadOnly := True; ListView1.ReadOnly := True;
EditSearch.text := rsExSearchPrompt; LastListViewIndex := -1; // Used to record ListView1.ItemIndex before Tabbing away
EditSearch.TextHint := rsExSearchPrompt;
CheckGroupCategory.Hint := rsGroupHint; CheckGroupCategory.Hint := rsGroupHint;
Ex := nil; Ex := nil;
// These are ObjectInspector set but I believe I cannot get OI literals set in a Package ?? // These are ObjectInspector set but I believe I cannot get OI literals set in a Package ??
@ -459,7 +481,13 @@ end;
procedure TFormLazExam.FormDestroy(Sender: TObject); procedure TFormLazExam.FormDestroy(Sender: TObject);
begin begin
if Ex <> nil then Ex.Free; Ex.Free;
end;
procedure TFormLazExam.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = VK_ESCAPE then
ModalResult := mrClose;
end; end;
procedure TFormLazExam.FormShow(Sender: TObject); procedure TFormLazExam.FormShow(Sender: TObject);
@ -467,10 +495,11 @@ var
i : integer; i : integer;
begin begin
Memo1.clear; Memo1.clear;
EditSearch.text := ''; // or should we resume previous search ?
Top := Screen.Height div 10; Top := Screen.Height div 10;
Height := Screen.Height * 7 div 10; Height := Screen.Height * 7 div 10;
ListView1.Height:= Screen.Height * 3 div 10; ListView1.Height:= Screen.Height * 3 div 10;
if Ex <> Nil then Ex.Free; Ex.Free;
StatusBar1.SimpleText := rsExSearchingForExamples; StatusBar1.SimpleText := rsExSearchingForExamples;
Ex := TExampleData.Create(); Ex := TExampleData.Create();
Ex.GitDir := GitDir; Ex.GitDir := GitDir;
@ -490,9 +519,7 @@ begin
ListView1.Clear; ListView1.Clear;
PrimeCatFilter(); PrimeCatFilter();
LoadUpListView(); LoadUpListView();
if EditSearch.Text <> rsExSearchPrompt then ListView1.SetFocus;
KeyWordSearch()
else EditSearch.SetFocus;
end; end;
{ Must add a FormClose event { Must add a FormClose event