unit uLaz_Examples; { ********************************************************************** This file is part of a Lazarus Package, Examples Window. See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ********************************************************************** This unit displays all the examples that it can find metadata for. At present it looks in the LazarusDir and then the LazConfigDir (but can be made to look online). It scans the examples and makes Catagory Checkboxes for all the Categories it finds. In OnLine mode, will look for a master meta file in LazConfigDir/examples If its not there, it will try to download one from Remote. In either case will scan the LazConfigDir (excluding Examples ???) looking for 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, LCLType, LCLIntf, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, ExtCtrls, Buttons, {$ifndef EXTESTMODE} IDEImagesIntf, IDEWindowIntf, {$endif} uExampleData, uConst; type { TFormLazExam } TFormLazExam = class(TForm) ButtonView: TButton; ButtonRefresh: TButton; ButtonClose: TButton; ButtonOpen: TButton; CheckGroupCategory: TCheckGroup; EditSearch: TEdit; ListView1: TListView; Memo1: TMemo; ClearSearchButton: TSpeedButton; Splitter2: TSplitter; StatusBar1: TStatusBar; procedure ButtonCloseClick(Sender: TObject); procedure ButtonRefreshClick(Sender: TObject); procedure ButtonOpenClick(Sender: TObject); procedure ButtonViewClick(Sender: TObject); procedure CheckGroupCategoryDblClick(Sender: TObject); 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; Shift: TShiftState); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); 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; Shift: TShiftState); procedure ListView1KeyPress(Sender: TObject; var Key: char); procedure ListView1SelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); private MoveFocusKey : char; // 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. // Proj should be lowercase, used as dir name, as per Lazarus std function CopyFiles(const Proj, SrcDir, DestDir: string): boolean; // 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, KeyWords: string; ExIndex: PtrInt); // Displays the current content of Examples List in the listview and // populates the Category checkboxes. procedure LoadUpListView(); public GitDir : string; // Not needed in Lazarus Package, used in dev's tool emt LazConfigDir : string; // We will look for Laz config here. ExamplesHome : string; // Defaults to LazConfig but user settable RemoteRepo : string; // This is the full gitlab URL ProjectToOpen : string; // If not empty after close, open the project named. end; var FormLazExam: TFormLazExam; Ex : TExampleData; implementation {$R *.lfm} { TFormLazExam } // ------------------------ L I S T V I E W ---------------------------------- 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.Data := pointer(ExIndex); // we are just storing an integer in here, not a pointer end; procedure TFormLazExam.ListView1SelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); begin ListView1Click(Sender); end; procedure TFormLazExam.LoadUpListView(); var 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); 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); ExIndex := Ex.FindListData(False, CFilter, KeyList); end; finally KeyList.Free; // Screen.Cursor := crDefault; ListView1.EndUpdate; end; ButtonOpen.Enabled := false; ButtonRefresh.enabled := false; ButtonView.enabled := false; 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 := PtrInt(ListView1.Selected.Data); // Yes, tacky cludge, its not a pointer, just an integer Memo1.Clear; Memo1.Append(ExtractFilePath(Ex.ExList[ExIndex]^.FFName)); Memo1.append(''); Memo1.Append(Ex.ExList[ExIndex]^.Desc); ButtonOpen.Enabled := True; if Ex.ExList[ExIndex]^.ThirdParty then begin ButtonRefresh.Enabled := False; ButtonView.Enabled := False; end else begin // A Lazarus Example ButtonRefresh.Enabled := Ex.IsValidProject(ExIndex); ButtonView.Enabled := True; end; end; procedure TFormLazExam.ListView1DblClick(Sender: TObject); // A doubleclick will select that row, but it happens after OnEnter. begin if ListView1.Selected = Nil then exit else { 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 ????? end; procedure TFormLazExam.ListView1Exit(Sender: TObject); begin // 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; Shift: TShiftState); begin if Key = VK_RETURN then begin 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); end; end; procedure TFormLazExam.ListView1KeyPress(Sender: TObject; var Key: char); begin MoveFocusKey := Key; Key := char(0); EditSearch.SetFocus; end; // --------------------- B U T T O N S ----------------------------------------- procedure TFormLazExam.ButtonOpenClick(Sender: TObject); var ExIndex : integer; begin 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.DoCopy(); var ExIndex : integer; begin 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 Application.MessageBox(pchar(rsRefreshExistingExample) , pchar(ListView1.Selected.Caption) , MB_ICONQUESTION + MB_YESNO) <> IDYES then exit; // OK - we overwrite. Any other files user has added are not removed end; Screen.Cursor := crHourGlass; Application.ProcessMessages; try if Ex <> nil then begin StatusBar1.SimpleText := rsExCopyingProject; 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 ExtractFilePath(Ex.ExList[ExIndex]^.FFName), Ex.ExampleWorkingDir()) then StatusBar1.SimpleText := rsExProjectCopiedTo + ' ' + Ex.ExampleWorkingDir() + ListView1.Selected.Caption else StatusBar1.SimpleText := rsFailedToCopyFilesTo + ' ' + Ex.ExampleWorkingDir(); end; finally Screen.Cursor := crDefault; Application.ProcessMessages; end; end; procedure TFormLazExam.ButtonRefreshClick(Sender: TObject); begin DoCopy(); end; procedure TFormLazExam.ButtonViewClick(Sender: TObject); var ExIndex : integer; St : string; begin 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; function TFormLazExam.CopyFiles(const Proj, SrcDir, DestDir : string) : boolean; var STL : TStringList; St : string; ChopOff : integer; begin ChopOff := length(ExpandFileName(AppendPathDelim(SrcDir))); if not ForceDirectoriesUTF8(DestDir + Proj) then exit(False); STL := FindAllDirectories(SrcDir, True); for St in STL do // note the copy process leaves a leading Pathdelim, good, I think... if not ForceDirectoriesUTF8(DestDir + Proj + copy(St, ChopOff, 1000)) then exit(False); STL.Free; STL := FindAllFiles(SrcDir, AllFilesMask, True, faAnyFile); for St in STL do begin if not copyfile(St, DestDir + Proj + copy(St, ChopOff, 1000)) then exit(False); // debugln('TFormLazExam.CopyFiles Copy ' + ST + #10 + ' to ' + DestDir + Proj + copy(St, ChopOff, 1000)); // debugln(' [' + DestDir + '] [' + Proj +'] [' + copy(St, ChopOff, 1000) +']'); end; STL.Free; end; // ----------------------- Check Boxes ----------------------------------------- procedure TFormLazExam.CheckGroupCategoryDblClick(Sender: TObject); var i : integer; begin for i := 0 to CheckGroupCategory.Items.Count -1 do CheckGroupCategory.Checked[i] := not CheckGroupCategory.Checked[i]; CheckGroupCategoryItemClick(Sender, 0); end; procedure TFormLazExam.CheckGroupCategoryItemClick(Sender: TObject; Index: integer); begin if Ex = Nil then exit; Memo1.clear; ListView1.Clear; // PrimeCatFilter(); // ToDo : remove LoadUpListView(); end; function TFormLazExam.DirExistsCaseInSense(const APath : string; out ActualFullDir : string) : boolean; var Info : TSearchRec; FName : string; begin FName := lowercase(extractFileName(ChompPathDelim(APath))); if FindFirst(extractFileDir(ChompPathDelim(APath))+PathDelim + '*',faDirectory, Info) = 0 then begin try repeat if (Info.Attr and faDirectory) = faDirectory then if lowercase(Info.Name) = FName then begin ActualFullDir := extractFileDir(ChompPathDelim(APath)) +PathDelim + Info.Name + PathDelim; exit(True); end; until FindNext(Info) <> 0; finally FindClose(Info); end; end; Result := False; end; // ---------------------- S E A R C H R E L A T E D -------------------------- // Build a StringList of the terms user has typed in, words or "groups of words" procedure TFormLazExam.BuildSearchList(SL : TStringList; const Term : AnsiString); var I : integer = 1; AWord : string = ''; InCommas : boolean = false; begin while I <= length(trim(Term)) do begin if Term[i] = '"' then begin if InCommas then begin SL.add(AWord); AWord := ''; InCommas := False; end else begin InCommas := true; end; inc(I); continue; end; if Term[i] = ' ' then begin if InCommas then AWord := AWord + Term[i] else begin if AWord <> '' then begin SL.Add(AWord); AWord := ''; end; end; inc(I); continue; end; AWord := AWord + Term[i]; inc(i); continue; end; if AWord <> '' then SL.Add(AWord); end; procedure TFormLazExam.KeyWordSearch(); begin Memo1.Clear; ListView1.Clear; Ex.KeyFilter := EditSearch.Text; LoadUpListView(); end; procedure TFormLazExam.EditSearchChange(Sender: TObject); begin ClearSearchButton.Enabled := EditSearch.Text <> '' ; if visible then KeyWordSearch(); end; procedure TFormLazExam.EditSearchEnter(Sender: TObject); // check to see if a char has been forwarded on from ListView begin if MoveFocusKey <> char(0) then begin // not all of this is needed for each widgetset, but does no harm EditSearch.Caption := EditSearch.Caption + MoveFocusKey; EditSearch.SelStart := length(EditSearch.Caption); EditSearch.SelLength := 0; MoveFocusKey := char(0); end; end; procedure TFormLazExam.EditSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key in [VK_RETURN, VK_DOWN] then begin Key := 0; if ListView1.items.Count > 0 then begin ListView1.SetFocus; if Key = VK_DOWN then begin // Is this logic for VK_DOWN good? ListView1.Selected := ListView1.Items[0]; ListView1.ItemFocused := ListView1.Items[0]; end; end; end; end; procedure TFormLazExam.ClearSearchButtonClick(Sender: TObject); begin if EditSearch.Text = '' then Exit; EditSearch.Text := ''; KeyWordSearch(); end; // -------------------- H O U S E K E E P I N G ------------------------------ procedure TFormLazExam.FormCreate(Sender: TObject); begin MoveFocusKey := char(0); Caption := rsExampleProjects; ListView1.Column[0].Caption := rsExampleName; ListView1.Column[1].Caption := rsExampleKeyWords; ListView1.AutoSortIndicator := True; ListView1.Column[0].SortIndicator := siDescending; ListView1.AutoSort := True; ListView1.SortDirection:= sdDescending; ListView1.AutoWidthLastColumn:= True; ListView1.ViewStyle:= vsReport; ListView1.Column[0].AutoSize := true; ListView1.Column[1].AutoSize := true; ListView1.ReadOnly := True; EditSearch.TextHint := rsExSearchPrompt; {$ifndef EXTESTMODE} ClearSearchButton.Images := IDEImages.Images_16; ClearSearchButton.ImageIndex := IDEImages.GetImageIndex('btnfiltercancel'); {$endif} ClearSearchButton.Enabled := False; CheckGroupCategory.Hint := rsGroupHint; Ex := nil; // These are ObjectInspector set but I believe I cannot get OI literals set in a Package ?? ButtonClose.Caption := rsExampleClose; ButtonView.Caption := rsExampleView; ButtonOpen.Caption := rsExampleOpen; ButtonRefresh.Caption := rsExampleRefresh; CheckGroupCategory.Caption := rsExampleCategory; {$ifndef EXTESTMODE} IDEDialogLayoutList.ApplyLayout(Self); {$endif} end; procedure TFormLazExam.FormDestroy(Sender: TObject); begin Ex.Free; end; procedure TFormLazExam.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_ESCAPE then ModalResult := mrClose; end; procedure TFormLazExam.FormShow(Sender: TObject); var i : integer; // T1, T2, T3, T4, T5 : dword; begin Screen.BeginWaitCursor; Application.ProcessMessages; DisableAutoSizing; // good improvement on form draw time //T1 := gettickcount64(); Memo1.clear; EditSearch.text := ''; Top := Screen.Height div 10; Height := Screen.Height * 7 div 10; ListView1.Height:= Screen.Height * 3 div 10; Ex.Free; StatusBar1.SimpleText := rsExSearchingForExamples; Ex := TExampleData.Create(); Ex.ExamplesHome := ExamplesHome; EX.LazConfigDir := LazConfigDir; //T2 := gettickcount64(); Ex.LoadExData(FromLazSrcTree); //T3 := gettickcount64(); Ex.LoadExData(FromThirdParty); if Ex.ErrorMsg <> '' then Showmessage(Ex.ErrorMsg); // Note : previously, we treated this as fatal ? //T4 := gettickcount64(); 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; 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.