paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-03 18:01:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

ExamplesWindow: Improve reading examples of packages more. Issue #40190, patch by dbannon.

Browse Source
This commit is contained in:
Juha 2023-04-21 12:05:37 +03:00
parent 1761863a45
commit 027553282a
7 changed files with 215 additions and 205 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
components/exampleswindow/languages/uconst.pot
View File

@ -17,14 +17,6 @@ msgstr ""
msgid "Close"
msgstr ""
#: uconst.rsexamplecopy
msgid "Copy to work area"
msgstr ""
#: uconst.rsexampledownload
msgid "Download"
msgstr ""
#: uconst.rsexamplekeywords
msgid "Keywords"
msgstr ""
@ -45,6 +37,10 @@ msgstr ""
msgid "Example Projects"
msgstr ""
#: uconst.rsexamplerefresh
msgid "Refresh"
msgstr ""
#: uconst.rsexampleview
msgid "View in Browser"
msgstr ""

12
components/exampleswindow/languages/uconst.pt_BR.po
View File

@ -28,14 +28,6 @@ msgstr "Categoria"
msgid "Close"
msgstr "Fechar"
#: uconst.rsexamplecopy
msgid "Copy to work area"
msgstr "Copiar para a área de trabalho"
#: uconst.rsexampledownload
msgid "Download"
msgstr "Download"
#: uconst.rsexamplekeywords
msgid "Keywords"
msgstr "Palavras-chave"
@ -56,6 +48,10 @@ msgstr "Caminho"
msgid "Example Projects"
msgstr "Projetos de exemplo"
#: uconst.rsexamplerefresh
msgid "Refresh"
msgstr ""
#: uconst.rsexampleview
msgid "View in Browser"
msgstr "Visualizar no navegador"

12
components/exampleswindow/languages/uconst.ru.po
View File

@ -27,14 +27,6 @@ msgstr "Категория"
msgid "Close"
msgstr "Закрыть"
#: uconst.rsexamplecopy
msgid "Copy to work area"
msgstr "Копировать в рабочую область"
#: uconst.rsexampledownload
msgid "Download"
msgstr "Загрузить"
#: uconst.rsexamplekeywords
msgid "Keywords"
msgstr "Ключевые слова"
@ -55,6 +47,10 @@ msgstr "Путь"
msgid "Example Projects"
msgstr "Примеры проектов"
#: uconst.rsexamplerefresh
msgid "Refresh"
msgstr ""
#: uconst.rsexampleview
msgid "View in Browser"
msgstr "Просмотреть в браузере"

9
components/exampleswindow/uconst.pas
View File

@ -24,7 +24,8 @@ const
// Immediate Local dir name under which we copy or
cExamplesDir = 'examples_work_dir'; // download examples to. Carefull about simplifying it
cConfigFileName = 'exampleprojectscfg.xml';
BaseURL = 'https://gitlab.com/dbannon/laz_examples/-/tree/main/'; // Online Examples, there for testing for now...
// BaseURL = 'https://gitlab.com/dbannon/laz_examples/-/tree/main/'; // Online Examples, there for testing for now...
BaseURL = 'https://gitlab.com/freepascal.org/lazarus/lazarus/-/tree/main/';
resourcestring
@ -50,15 +51,15 @@ resourcestring
// These are ObjectInspector set but I believe I cannot get OI literals i18n in a Package ??
rsExampleOpen = 'Open'; // Button Caption
rsExampleDownload = 'Download'; // "
// rsExampleDownload = 'Download'; // "
rsExampleClose = 'Close'; // "
rsExampleCategory = 'Category'; // "
rsExampleCopy = 'Copy to work area'; // "
rsExampleRefresh = 'Refresh'; // "
rsExampleView = 'View in Browser'; // "
// Settings Frame
rsGeneral = 'General';
rsDirWhereExamplesGo = 'Directory where Examples go';
rsGeneral = 'General';
rsDefault = 'Default';
// ------- rsExampleData

136
components/exampleswindow/uexampledata.pas
View File

@ -70,16 +70,17 @@ type
procedure DumpList(wherefrom: string; ShowDesc: boolean = false);
function Get(Index: integer): PExRec;
function IsInKeywords(St : string; AnIndex : integer) : boolean;
public
constructor Create();
destructor Destroy; override;
// Public - Puts new entry in List, Keys may be Nil
function InsertData(Cat, Desc, FFName, AName: string; Keys: TStringList; IsTP: boolean=true): boolean;
function Find(const FFname: string): PExRec;
function AsJSON(Index: integer): string;
// Ret T if St is in Keywords at AnIndex, not necessarily equal to.
function IsInKeywords(St : string; AnIndex : integer) : boolean;
// function AsJSON(Index: integer): string;
// Ret T if all the strings in STL can match something in this record.
function IsInKeyWords(STL : TStringList; AnIndex : integer) : boolean;
property Items[Index: integer]: PExRec read Get; default;
end;
@ -96,9 +97,10 @@ type
// with the list filled with paths to some directory above the package
// lpk file being a suitable place to start searching for Examples.
procedure CollectThirdPartyPackages(PkgFilesXML: String; AList, SList: TStrings);
function GetTheRecord(const FFname: string): PExRec;
// Returns true if it has altered FullPkgFileName to where we can expect to find Examples
function GetThirdPartyDir(var FullPkgFileName: string): boolean;
function GetThirdPartyDir(var FullPkgFileName: string; CheckRunTimeOnly: boolean): boolean;
procedure ScanLazarusSrc;
// Triggers a search of installed Third Party packages. Iterates over packagefiles.xml
// and puts any potential paths to example directories in a list. Then iterates over
@ -137,8 +139,12 @@ type
ExamplesHome : string; // dir above examples_working_dir where we copy examples to, set by uintf.pas, usually <lazConf>/
LazSrcDir : string; // Laz dir where, eg ~/examples lives
KeyFilter : string; // A list of words, possibly grouped by " to filter Keywords
CatFilter : string; // A string that may contain 0 to n words, each word being a category as filtered by GetListData()
// CatFilter : string; // A string that may contain 0 to n words, each word being a category as filtered by GetListData()
// Returns an index to EXList complying with supplied KeyWords and or CatFilter,
// if GetFirst, starts with lowest complient entry, then, increasing. Returns -1
// when it can find no more
function FindListData(GetFirst: boolean; TheCatFilter: string; KeyList: TStringList=nil): integer;
// A service function, tests passed St to ensure its
// a valid lump of Example Meta Data.
function TestJSON(const J: string; out Error, Cat: string): boolean;
@ -149,8 +155,9 @@ type
// Public, returns with next set of data, false if no more available.
// Filters using CatFilter if CatFilter is not empty.
// If passed KeyList is not nil, filters keywords against KeyList.
function GetListData(out Proj, Cat, Path, Keys: string; out Index: integer;
GetFirst: boolean; KeyList: TStringList=nil): boolean;
// function GetListData(out Proj, Cat, Path, Keys: string; out Index: integer; // ToDo : remove this ?
// GetFirst: boolean; KeyList: TStringList=nil): boolean;
// Passed a created TStrings that it clears and fills in with all know categories
function getCategoryData(const ACatList : TStrings) : boolean;
constructor Create;
@ -205,7 +212,7 @@ begin
end;
// Returns an unquoted string being one JSON Escaped record from list.
function TExampleList.AsJSON(Index : integer) : string; // Not used, maybe remove ? Or Add in EName
(*function TExampleList.AsJSON(Index : integer) : string; // Not used, maybe remove ? Or Add in EName
begin
Result := '';
Result := Result + 'Category : ' + Items[Index]^.Category + #10;
@ -213,9 +220,9 @@ begin
Result := Result + Items[Index]^.Desc;
Result := Result.Replace('\', '\\', [rfReplaceAll] );
Result := Result.Replace('"', '\"', [rfReplaceAll] );
end;
end; *)
function TExampleList.IsInKeywords(St: string; AnIndex: integer): boolean;
function TExampleList.IsInKeywords(St: string; AnIndex: integer): boolean; // ToDo : private now I think
var KeyWord : String;
begin
result := false;
@ -225,6 +232,20 @@ begin
end;
end;
// Passed a List of keywords, tests each one against the list in the indicated
// TExampleList item, returns false if if finds a string that if not included
// in the TExampleList item keywords. Not a 1:1 match, the passed string can be
// a substring of the TExampleList item keyword. Not visa versa. Case Insensitive
function TExampleList.IsInKeyWords(STL: TStringList; AnIndex: integer): boolean;
var
St : string;
begin
for St in STL do
if not IsInKeywords(St, AnIndex)
then exit(False);
result := true;
end;
procedure TExampleList.DumpList(wherefrom: string; ShowDesc : boolean = false); // ToDo : remove this, its just a debug method
var
@ -277,12 +298,16 @@ end;
procedure TExampleData.CollectThirdPartyPackages(PkgFilesXML: String; AList, SList: TStrings);
// Think of this as iterating over the packagefiles.xml file, UserPkgLinks. If
// pkg is mentioned in staticpackages.inc, we tell GetThirdPartyDir() to not
// worry about testing for RunTimeOnly.
var
doc: TXMLDocument;
userPkgLinks, pkgNode: TDOMNode;
NameNode, FileNameNode: TDOMNode;
FileNameAttr, NameAttr : TDOMNode;
St : String;
OnlyIfRunTime : boolean = false; // if it turns out that it was not listed in staticpackages.inc
begin
if not FileExists(PkgFilesXML) then
exit;
@ -300,13 +325,12 @@ begin
NameAttr := NameNode.Attributes.GetNamedItem('Value');
if not ((FileNameAttr = nil) or (NameAttr = nil)) then begin
St := NameAttr.Nodevalue;
if SList.IndexOf(St) > -1 then begin
St := filenameAttr.Nodevalue;
ForcePathDelims(St); // ExtractFileDir has problems with unexpected pathdelim....
if GetThirdPartyDir(St) then begin
OnlyIfRunTime := SList.IndexOf(St) < 0; // Comment this line to disallow RunTimeOnly
St := filenameAttr.Nodevalue;
ForcePathDelims(St);
if GetThirdPartyDir(St, OnlyIfRunTime) then begin
{$ifdef SHOW_DEBUG}debugln('CollectThirdPartyPackages adding St [' + St + ']');{$endif}
AList.Add(St);
end;
end;
end;
end;
@ -320,13 +344,19 @@ end;
{ We look for a tag like <ExampleDirectory="../."/> just below <Package....
If we find it, we use that, relative to the actual path of the LPK file to
determine where we should, later, look for Examples.}
determine where we should, later, look for Examples.
function TExampleData.GetThirdPartyDir(var FullPkgFileName: string): boolean;
if CheckRunTimeOnly, then it has aleady failed the staticpackages.inc test,
we give it a second chance, is it a RunTimeOnly ?
That is one without a <Type Value=xxx> element OR one with a <Type Value="RunTimeOnly"/>
But still must have the <ExampleDirectory Value=yyy> element.
}
function TExampleData.GetThirdPartyDir(var FullPkgFileName: string; CheckRunTimeOnly : boolean): boolean;
var
doc: TXMLDocument;
NodeA, NodeB: TDOMNode;
ADir : string = 'INVALID';
ADir : string = 'INVALID'; // Set to relative path from .lpk file to a dir above examples if available.
begin
Result := true;
{$ifdef SHOW_DEBUG}debugln('TExampleData.GetThirdParty - looking at [' + FullPkgFileName + ']');{$endif}
@ -347,7 +377,6 @@ begin
if NodeB = nil then exit;
NodeA := NodeB.FindNode('ExamplesDirectory');
if NodeA <> nil then begin
{$ifdef SHOW_DEBUG} debugln('ExampleDir Mode');{$endif}
NodeB := NodeA.Attributes.GetNamedItem('Value');
if NodeB <> nil then // Leave existing path in FullPkgFileName, ie assumes LPK file is level or above examples
ADir := NodeB.NodeValue; // maybe something like eg ../../Examples
@ -358,8 +387,20 @@ begin
if ADir = 'INVALID' then
exit(False)
else FullPkgFileName := ExpandFileName(appendPathDelim(FullPkgFileName) + ADir);
if not DirectoryExists(FullPkgFileName) then begin
debugln('Warning : [TExampleData.GetThirdPartyDir] : invalid directory for examples - ' + FullPkgFileName);
exit(False);
end;
if CheckRunTimeOnly then begin // seems it must be a RunTimeOnly package, was not found in staticfiles.inc
NodeA := NodeB.FindNode('Type');
if NodeA <> nil then begin // Not being there is good, indicates its RunTimeOnly
NodeB := NodeA.Attributes.GetNamedItem('Value');
if NodeB.NodeValue <> 'RunTimeOnly' then // if anything there, only RunTimeOnly works.
exit(False);
end;
end;
{$ifdef SHOW_DEBUG}
debugln('GetThirdParty - FullPkgFileName=[' + FullPkgFileName +']');
debugln('TExampleData.GetThirdParty - returning FullPkgFileName=[' + FullPkgFileName +']');
{$endif}
finally
doc.free;
@ -572,6 +613,7 @@ var
STL : TStringList = nil;
St : string;
begin
Result := True;
STL := FindAllFiles(Path, '*' + MetaFileExt, True);
try
for St in STL do begin
@ -664,49 +706,29 @@ end;
// ******************** Methods relating to using the data *******************
function TExampleData.GetListData(out Proj, Cat, Path, Keys : string; out Index : integer;
GetFirst: boolean; KeyList : TStringList = nil): boolean;
// ToDo : this would be a lot better just returning with the Index and letting calling process use Ex.ExList[i]^.xxxx
var
St : string;
DoContinue : boolean = false;
function TExampleData.FindListData(GetFirst: boolean; TheCatFilter : string; KeyList : TStringList = nil) : integer;
begin
Result := True;
if CatFilter = '' then exit(False);
Result := -1;
if TheCatFilter = '' then exit;
if GetFirst then
GetListDataIndex := 0;
GetListDataIndex := -1;
while True do begin
if GetListDataIndex >= ExList.Count then exit(False);
if CatFilter <> '' then begin // Find an entry in one of the categories
// orig a while instead of if, needed to use DoContinue ... Why ?
if pos(ExList.Items[GetListDataIndex]^.Category, CatFilter) < 1 then begin
inc(GetListDataIndex);
if GetListDataIndex >= ExList.Count then exit; // end of list
if TheCatFilter <> '' then begin // Find an entry in one of the categories
// skip ahead until we find next item with complient Category
if pos(ExList.Items[GetListDataIndex]^.Category, TheCatFilter) < 1 then begin
inc(GetListDataIndex);
if GetListDataIndex >= ExList.Count then exit;
continue;
end;
end;
Assert(Assigned(KeyList), 'TExampleData.GetListData: KeyList=Nil');
for St in KeyList do
// IndexOf requires a 1:1 match, we want to know if St is in the keyword.
//if ExList.Items[GetListDataIndex]^.Keywords.IndexOf(St) = -1 then begin
if not ExList.IsInKeywords(St, GetListDataIndex) then begin
inc(GetListDataIndex);
DoContinue := True;
Break;
end;
if DoContinue then begin // Hmm, a GoTo would be easier ......
DoContinue := False;
Continue;
end;
break;
end; // if to here, have an entry thats a match for category, how about keywords ?
if KeyList = nil then exit(GetListDataIndex); // thats all we need then
if ExList.IsInKeywords(KeyList, GetListDataIndex) then // Found one !
exit(GetListDataIndex);
// else, we loop around again, first find a category match then a keyword match, in both cases, if required.
end;
Proj := ExList.Items[GetListDataIndex]^.EName;
Cat := ExList.Items[GetListDataIndex]^.Category;
Path := ExtractFilePath(ExList.Items[GetListDataIndex]^.FFname);
Index := GetListDataIndex;
Keys := '';
for St in ExList.Items[GetListDataIndex]^.Keywords do
Keys := Keys + St + ' ';
inc(GetListDataIndex);
end;
function TExampleData.getCategoryData(const ACatList: TStrings): boolean;

59
components/exampleswindow/ulaz_examples.lfm
View File

@ -3,7 +3,7 @@ object FormLazExam: TFormLazExam
Height = 400
Top = 304
Width = 781
Caption = 'Prototype Lazarus Examples Window'
Caption = 'Lazarus Examples Window'
ClientHeight = 400
ClientWidth = 781
KeyPreview = True
@ -59,10 +59,7 @@ object FormLazExam: TFormLazExam
Width = 10
end
item
Width = 10
end
item
Width = 740
Width = 750
end>
ParentShowHint = False
ReadOnly = True
@ -129,46 +126,48 @@ object FormLazExam: TFormLazExam
Width = 781
Panels = <>
end
object ButtonCopy: TButton
AnchorSideLeft.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonOpen
AnchorSideBottom.Side = asrBottom
Left = 6
Height = 31
Top = 340
Width = 50
Anchors = [akLeft, akBottom]
AutoSize = True
BorderSpacing.Left = 6
Caption = 'Copy'
OnClick = ButtonCopyClick
TabOrder = 5
end
object ButtonClose: TButton
object ButtonRefresh: TButton
AnchorSideLeft.Control = ButtonView
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonOpen
AnchorSideBottom.Side = asrBottom
Left = 231
Left = 175
Height = 31
Top = 340
Width = 54
Width = 73
Anchors = [akLeft, akBottom]
AutoSize = True
BorderSpacing.Left = 6
Caption = 'Refresh'
OnClick = ButtonRefreshClick
TabOrder = 7
end
object ButtonClose: TButton
AnchorSideLeft.Control = ButtonView
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonOpen
AnchorSideBottom.Side = asrBottom
Left = 721
Height = 31
Top = 340
Width = 54
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 6
BorderSpacing.Right = 6
Caption = 'Close'
ModalResult = 11
OnClick = ButtonCloseClick
TabOrder = 8
end
object ButtonOpen: TButton
AnchorSideLeft.Control = ButtonCopy
AnchorSideLeft.Side = asrBottom
AnchorSideLeft.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = StatusBar1
Left = 62
Left = 6
Height = 31
Top = 340
Width = 54
@ -178,7 +177,7 @@ object FormLazExam: TFormLazExam
BorderSpacing.Bottom = 6
Caption = 'Open'
OnClick = ButtonOpenClick
TabOrder = 6
TabOrder = 5
end
object ButtonView: TButton
AnchorSideLeft.Control = ButtonOpen
@ -186,7 +185,7 @@ object FormLazExam: TFormLazExam
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonOpen
AnchorSideBottom.Side = asrBottom
Left = 122
Left = 66
Height = 31
Top = 340
Width = 103
@ -195,7 +194,7 @@ object FormLazExam: TFormLazExam
BorderSpacing.Left = 6
Caption = 'ButtonView'
OnClick = ButtonViewClick
TabOrder = 7
TabOrder = 6
end
object EditSearch: TEdit
AnchorSideLeft.Control = Owner

180
components/exampleswindow/ulaz_examples.pas
View File

@ -1,4 +1,5 @@
unit uLaz_Examples;
{
**********************************************************************
This file is part of a Lazarus Package, Examples Window.
@ -19,23 +20,26 @@ potential 'other' example projects, recognisable by a valid json file with an
extension of ex-meta.
David Bannon, Dec 2022
}
{$mode objfpc}{$H+}
{X$define ONLINE_EXAMPLES}
interface
uses
Classes, SysUtils,
LazFileUtils, fileutil, LazLoggerBase,
LazFileUtils, FileUtil, LazLoggerBase,
LCLType, LCLIntf, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
ExtCtrls, Buttons,
{$ifndef EXTESTMODE}
IDEImagesIntf,
IDEWindowIntf,
{$endif}
uexampledata, uConst;
uExampleData, uConst;
type
@ -43,7 +47,7 @@ type
TFormLazExam = class(TForm)
ButtonView: TButton;
ButtonCopy: TButton;
ButtonRefresh: TButton;
ButtonClose: TButton;
ButtonOpen: TButton;
CheckGroupCategory: TCheckGroup;
@ -54,29 +58,29 @@ type
Splitter2: TSplitter;
StatusBar1: TStatusBar;
procedure ButtonCloseClick(Sender: TObject);
procedure ButtonCopyClick(Sender: TObject);
procedure ButtonRefreshClick(Sender: TObject);
procedure ButtonOpenClick(Sender: TObject);
procedure ButtonViewClick(Sender: TObject);
procedure CheckGroupCategoryDblClick(Sender: TObject);
procedure CheckGroupCategoryItemClick(Sender: TObject; {%H-}Index: integer);
procedure CheckGroupCategoryItemClick(Sender: TObject; Index: integer);
procedure ClearSearchButtonClick(Sender: TObject);
procedure EditSearchChange(Sender: TObject);
procedure EditSearchEnter(Sender: TObject);
procedure EditSearchKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure EditSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormShow(Sender: TObject);
procedure ListView1Click(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; Shift: TShiftState);
procedure ListView1KeyPress(Sender: TObject; var Key: char);
procedure ListView1SelectItem(Sender: TObject; {%H-}Item: TListItem; {%H-}Selected: Boolean);
procedure ListView1SelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
private
MoveFocusKey : char;
LastListViewIndex : integer; // If 0 or greater, its an index to ListView
// LastListViewIndex : integer; // If 0 or greater, its an index to ListView
procedure BuildSearchList(SL: TStringList; const Term: AnsiString);
// Copies the passed ex dir to a dir named for the Proj.
// SrcDir includes name of actual dir, DestDir does not.
@ -85,12 +89,13 @@ type
// Checks for existance of passed path, the last element of which is case Insensitive.
// Returns with the actual name of the full path if successful.
function DirExistsCaseInSense(const APath: string; out ActualFullDir: string) : boolean;
procedure DoCopy();
procedure KeyWordSearch;
procedure NewLVItem(const Proj, Path, KeyWords, Cat: string; ExIndex: integer);
procedure NewLVItem(const Proj, KeyWords: string; ExIndex: PtrInt);
// Displays the current content of Examples List in the listview and
// populates the Category checkboxes.
procedure LoadUpListView();
procedure PrimeCatFilter;
public
GitDir : string; // Not needed in Lazarus Package, used in dev's tool emt
LazConfigDir : string; // We will look for Laz config here.
@ -109,18 +114,15 @@ implementation
{ TFormLazExam }
// ------------------------ L I S T V I E W ----------------------------------
procedure TFormLazExam.NewLVItem(const Proj, Path, KeyWords, Cat : string; ExIndex : integer);
procedure TFormLazExam.NewLVItem(const Proj, KeyWords : string; ExIndex : PtrInt);
var
TheItem : TListItem;
begin
TheItem := ListView1.Items.Add;
TheItem.Caption := Proj;
TheItem.SubItems.Add(KeyWords);
TheItem.SubItems.Add(Path); // Thats the original path, not the working copy
TheItem.SubItems.Add(Cat);
TheItem.Data := pointer(ExIndex); // we are just storing an integer in here, not a pointer
end;
@ -131,25 +133,29 @@ end;
procedure TFormLazExam.LoadUpListView();
var
Proj, Cat, Path, KeyW : string;
Cnt : integer = 0;
i : integer;
ExIndex : integer;
KeyList : TStringList = nil;
CFilter : string = '';
KeyW : string;
St : string;
begin
// Screen.Cursor := crHourGlass;
KeyList := TStringList.Create;
for i := 0 to CheckGroupCategory.Items.Count -1 do begin
if CheckGroupCategory.Checked[i] then
CFilter := CFilter + CheckGroupCategory.Items[i] + ' ';
end;
ListView1.BeginUpdate;
try
BuildSearchList(KeyList, EditSearch.Text);
if Ex.GetListData(Proj, Cat, Path, KeyW, ExIndex, True, KeyList) then begin
NewLVItem(Proj, ExtractFilePath(Ex.ExList[ExIndex]^.FFName), KeyW, Ex.ExList[ExIndex]^.Category, ExIndex);
// NewLVItem(Proj, Path, KeyW, Cat);
inc(Cnt);
end;
while Ex.GetListData(Proj, Cat, Path, KeyW, ExIndex, False, KeyList) do begin
NewLVItem(Proj, ExtractFilePath(Ex.ExList[ExIndex]^.FFName), KeyW, Ex.ExList[ExIndex]^.Category, ExIndex);
// NewLVItem(Proj, Path, KeyW, Cat);
inc(Cnt);
ExIndex := Ex.FindListData(True, CFilter, KeyList);
while ExIndex > -1 do begin
KeyW := '';
for St in EX.ExList.Items[ExIndex]^.Keywords do
KeyW := KeyW + St + ' ';
NewLVItem(Ex.ExList[ExIndex]^.EName, KeyW, ExIndex); // ToDo : review items
ExIndex := Ex.FindListData(False, CFilter, KeyList);
end;
finally
KeyList.Free;
@ -157,29 +163,29 @@ begin
ListView1.EndUpdate;
end;
ButtonOpen.Enabled := false;
ButtonCopy.enabled := false;
ButtonRefresh.enabled := false;
ButtonView.enabled := false;
Memo1.append(format(rsFoundExampleProjects, [Cnt]));
StatusBar1.SimpleText := format(rsFoundExampleProjects, [Cnt]);
LastListViewIndex := -1; // start afresh
Memo1.append(format(rsFoundExampleProjects, [ListView1.Items.Count]));
StatusBar1.SimpleText := format(rsFoundExampleProjects, [ListView1.Items.Count]);
end;
procedure TFormLazExam.ListView1Click(Sender: TObject);
var
ExIndex : integer;
begin
if ListView1.Selected = nil then exit; // White space below entries ....
ExIndex := integer(ListView1.Selected.Data); // Yes, tacky cludge, its not a pointer, just an integer
if ListView1.Selected = nil then exit; // White space below entries ....
ExIndex := PtrInt(ListView1.Selected.Data); // Yes, tacky cludge, its not a pointer, just an integer
Memo1.Clear;
Memo1.append(ListView1.Selected.SubItems[1]);
Memo1.Append(ExtractFilePath(Ex.ExList[ExIndex]^.FFName));
Memo1.append('');
Memo1.Append(Ex.ExList[ExIndex]^.Desc);
ButtonCopy.enabled := true;
ButtonView.enabled := true;
ButtonOpen.Enabled := Ex.IsValidProject(ExIndex);
ButtonOpen.Enabled := True;
if Ex.ExList[ExIndex]^.ThirdParty then begin
ButtonCopy.Enabled := False;
ButtonRefresh.Enabled := False;
ButtonView.Enabled := False;
end else begin // A Lazarus Example
ButtonRefresh.Enabled := Ex.IsValidProject(ExIndex);
ButtonView.Enabled := True;
end;
end;
@ -188,21 +194,23 @@ procedure TFormLazExam.ListView1DblClick(Sender: TObject);
begin
if ListView1.Selected = Nil then exit
else
LastListViewIndex := ListView1.ItemIndex; // So other methods can find user choice
ButtonCopyClick(self);
{ LastListViewIndex := ListView1.ItemIndex}; // So other methods can find user choice
if not Ex.IsValidProject(PtrInt(ListView1.Selected.Data)) then
DoCopy();
ButtonOpenClick(self);
end;
procedure TFormLazExam.ListView1Enter(Sender: TObject);
begin
ListView1.ItemIndex := LastListViewIndex; // possibly -1, half highlight item 0
// 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;
// This is no longer needed, remove !
// LastListViewIndex := ListView1.ItemIndex; // save it before we leave, we'll be back TABTAB
// ListView1.ClearSelection; // Interferes with tabbing.
// ListView1.ItemIndex := -1;
end;
procedure TFormLazExam.ListView1KeyDown(Sender: TObject; var Key: Word;
@ -230,28 +238,33 @@ end;
// --------------------- B U T T O N S -----------------------------------------
procedure TFormLazExam.ButtonOpenClick(Sender: TObject);
var
ExIndex : integer;
begin
if LastListViewIndex < 0 then exit;
ListView1.ItemIndex:= LastListViewIndex;
ProjectToOpen := Ex.GetProjectFile(integer(ListView1.Selected.Data)); // Yes, tacky cludge, its not a pointer, just an integer
if ProjectToOpen.IsEmpty then // Computer says no
if ListView1.ItemIndex < 0 then exit;
ExIndex := PtrInt(ListView1.Selected.Data); // Yes, tacky cludge, its not a pointer, just an integer
if not Ex.IsValidProject(ExIndex) then begin
DoCopy();
if not Ex.IsValidProject(ExIndex) then begin
showmessage('Error loading that example'); // no reason I can think of for that happening but ....
exit;
end;
end;
ProjectToOpen := Ex.GetProjectFile(ExIndex);
if ProjectToOpen.IsEmpty then // Computer says no
showmessage(rsExNoProjectFile)
else
close;
end;
procedure TFormLazExam.ButtonCopyClick(Sender: TObject);
procedure TFormLazExam.DoCopy();
var
ExIndex : integer;
begin
if LastListViewIndex < 0 then exit; // Can that happen ?
ListView1.ItemIndex:= LastListViewIndex;
ExIndex := integer(ListView1.Selected.Data); // Yes, tacky cludge, its not a pointer, just an integer
if Ex.ExList[ExIndex]^.ThirdParty then exit; // We don't 'download' ThirdParty examples.
if ListView1.ItemIndex < 0 then exit;
ExIndex := PtrInt(ListView1.Selected.Data); // Yes, tacky cludge, its not a pointer, just an integer
if Ex.ExList[ExIndex]^.ThirdParty then exit; // We don't 'copy' ThirdParty examples.
if Ex.IsValidProject(ExIndex) then begin
// if GetProjectFile(Ex.ExampleWorkingDir() + ListView1.Selected.Caption) then begin
if Application.MessageBox(pchar(rsRefreshExistingExample)
, pchar(ListView1.Selected.Caption)
, MB_ICONQUESTION + MB_YESNO) <> IDYES then exit;
@ -265,7 +278,7 @@ begin
Application.ProcessMessages;
// note we copy files to exampleworkingdir + lowercase(exampe name)
if copyFiles( lowercase(ListView1.Selected.Caption), // force toplevel ex dir to lowercase as per lazarus std
ListView1.Selected.SubItems[1], Ex.ExampleWorkingDir()) then
ExtractFilePath(Ex.ExList[ExIndex]^.FFName), Ex.ExampleWorkingDir()) then
StatusBar1.SimpleText := rsExProjectCopiedTo + ' ' + Ex.ExampleWorkingDir()
+ ListView1.Selected.Caption
else StatusBar1.SimpleText := rsFailedToCopyFilesTo + ' ' + Ex.ExampleWorkingDir();
@ -274,22 +287,29 @@ begin
Screen.Cursor := crDefault;
Application.ProcessMessages;
end;
ButtonOpen.Enabled := Ex.IsValidProject(ExIndex);
ListView1.ItemIndex := -1; // Unselect again for the Tabbers of this world.
end;
procedure TFormLazExam.ButtonRefreshClick(Sender: TObject);
begin
DoCopy();
end;
procedure TFormLazExam.ButtonViewClick(Sender: TObject);
var
ExIndex : integer;
St : string;
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);
ListView1.ItemIndex := -1;
if ListView1.ItemIndex < 0 then exit;
ExIndex := PtrInt(ListView1.Selected.Data);
St := Ex.ExList[ExIndex]^.FFName;
delete(St, 1, length(Ex.LazSrcDir));
St := ExtractFilePath(St);
OpenURL(BaseURL + St);
end;
procedure TFormLazExam.ButtonCloseClick(Sender: TObject);
begin
ProjectToOpen := ''; // To be sure, to be sure
Close;
end;
@ -331,7 +351,7 @@ begin
if Ex = Nil then exit;
Memo1.clear;
ListView1.Clear;
PrimeCatFilter();
// PrimeCatFilter(); // ToDo : remove
LoadUpListView();
end;
@ -447,19 +467,6 @@ begin
KeyWordSearch();
end;
procedure TFormLazExam.PrimeCatFilter();
var
i : integer;
St : string = '';
begin
for i := 0 to CheckGroupCategory.Items.Count -1 do begin
if CheckGroupCategory.Checked[i] then
St := St + CheckGroupCategory.Items[i] + ' ';
end;
Ex.CatFilter := St;
end;
// -------------------- H O U S E K E E P I N G ------------------------------
procedure TFormLazExam.FormCreate(Sender: TObject);
@ -468,7 +475,6 @@ begin
Caption := rsExampleProjects;
ListView1.Column[0].Caption := rsExampleName;
ListView1.Column[1].Caption := rsExampleKeyWords;
ListView1.Column[2].Caption := rsExamplePath;
ListView1.AutoSortIndicator := True;
ListView1.Column[0].SortIndicator := siDescending;
ListView1.AutoSort := True;
@ -477,10 +483,7 @@ begin
ListView1.ViewStyle:= vsReport;
ListView1.Column[0].AutoSize := true;
ListView1.Column[1].AutoSize := true;
ListView1.Column[2].Visible := false;
ListView1.ReadOnly := True;
LastListViewIndex := -1; // Used to record ListView1.ItemIndex before Tabbing away
EditSearch.TextHint := rsExSearchPrompt;
{$ifndef EXTESTMODE}
ClearSearchButton.Images := IDEImages.Images_16;
@ -491,13 +494,9 @@ begin
Ex := nil;
// These are ObjectInspector set but I believe I cannot get OI literals set in a Package ??
ButtonClose.Caption := rsExampleClose;
{$ifdef ONLINE_EXAMPLES}
ButtonCopy.Caption := rsExampleDownLoad;
{$else}
ButtonCopy.Caption := rsExampleCopy;
{$endif}
ButtonView.Caption := rsExampleView;
ButtonOpen.Caption := rsExampleOpen;
ButtonRefresh.Caption := rsExampleRefresh;
CheckGroupCategory.Caption := rsExampleCategory;
{$ifndef EXTESTMODE}
IDEDialogLayoutList.ApplyLayout(Self);
@ -522,6 +521,7 @@ var
begin
Screen.BeginWaitCursor;
Application.ProcessMessages;
DisableAutoSizing; // good improvement on form draw time
T1 := gettickcount64();
Memo1.clear;
EditSearch.text := '';
@ -540,17 +540,17 @@ begin
if Ex.ErrorMsg <> '' then
Showmessage(Ex.ErrorMsg); // Note : previously, we treated this as fatal ?
T4 := gettickcount64();
CheckGroupCategory.Items := Ex.CatList; // 13-15mS for any of these
CheckGroupCategory.Items := Ex.CatList;
for i := 0 to CheckGroupCategory.items.Count-1 do // check all the categories we found.
CheckGroupCategory.Checked[i] := true;
ListView1.Clear;
PrimeCatFilter();
LoadUpListView();
ListView1.SetFocus;
T5 := gettickcount64();
Screen.EndWaitCursor;
Application.ProcessMessages;
debugln('TFormLazExam.FormShow Timing ' + inttostr(T2-T1) + 'mS ' + inttostr(T3-T2) + 'mS ' + inttostr(T4-T3) + 'mS ' + inttostr(T5-T4) + 'mS');
EnableAutoSizing;
end;
end.