diff --git a/components/exampleswindow/languages/uconst.pot b/components/exampleswindow/languages/uconst.pot index 346a4c44cc..ab7de20e69 100644 --- a/components/exampleswindow/languages/uconst.pot +++ b/components/exampleswindow/languages/uconst.pot @@ -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 "" diff --git a/components/exampleswindow/languages/uconst.pt_BR.po b/components/exampleswindow/languages/uconst.pt_BR.po index 6a36e00378..654d4e8f13 100644 --- a/components/exampleswindow/languages/uconst.pt_BR.po +++ b/components/exampleswindow/languages/uconst.pt_BR.po @@ -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" diff --git a/components/exampleswindow/languages/uconst.ru.po b/components/exampleswindow/languages/uconst.ru.po index ef5a9f67bf..147693b158 100644 --- a/components/exampleswindow/languages/uconst.ru.po +++ b/components/exampleswindow/languages/uconst.ru.po @@ -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 "Просмотреть в браузере" diff --git a/components/exampleswindow/uconst.pas b/components/exampleswindow/uconst.pas index 9634ea858a..49afb676fb 100644 --- a/components/exampleswindow/uconst.pas +++ b/components/exampleswindow/uconst.pas @@ -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 diff --git a/components/exampleswindow/uexampledata.pas b/components/exampleswindow/uexampledata.pas index 6ea17c1584..98deaf4dbd 100644 --- a/components/exampleswindow/uexampledata.pas +++ b/components/exampleswindow/uexampledata.pas @@ -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 / 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 just below element OR one with a + But still must have the 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; diff --git a/components/exampleswindow/ulaz_examples.lfm b/components/exampleswindow/ulaz_examples.lfm index dc358b6813..7d9e9fec7f 100644 --- a/components/exampleswindow/ulaz_examples.lfm +++ b/components/exampleswindow/ulaz_examples.lfm @@ -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 diff --git a/components/exampleswindow/ulaz_examples.pas b/components/exampleswindow/ulaz_examples.pas index 15f3eb3bbd..488ad0c5b5 100644 --- a/components/exampleswindow/ulaz_examples.pas +++ b/components/exampleswindow/ulaz_examples.pas @@ -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.