lazarus/components/exampleswindow/ulaz_examples.pas

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.

Notes -
    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+}

{x$define ONLINE_EXAMPLES}

interface

uses
    Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
    ExtCtrls, Interfaces, uexampledata, uConst
    {$ifndef EXTESTMODE}
    , IDEWindowIntf
    {$endif}
    ;


type

    { TFormLazExam }

    TFormLazExam = class(TForm)
        ButtonDownload: TButton;
        ButtonClose: TButton;
        ButtonOpen: TButton;
        CheckGroupCategory: TCheckGroup;
        EditSearch: TEdit;
        ListView1: TListView;
        Memo1: TMemo;
        Panel1: TPanel;
        Splitter2: TSplitter;
        StatusBar1: TStatusBar;
        procedure ButtonCloseClick(Sender: TObject);
        procedure ButtonDownloadClick(Sender: TObject);
        procedure ButtonOpenClick(Sender: TObject);
        procedure CheckGroupCategoryItemClick(Sender: TObject; Index: integer);
        procedure EditSearchExit(Sender: TObject);
        procedure EditSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
        procedure FormCreate(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure FormShow(Sender: TObject);
        procedure ListView1Click(Sender: TObject);
        procedure ListView1DblClick(Sender: TObject);
        procedure ListView1SelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
    private
        procedure BuildSearchList(SL: TStringList; const Term: AnsiString);
                        // SrcDir includes name of actual dir, DestDir does not.
        function CopyFiles(const Proj, SrcDir, DestDir: string): boolean;
        function DirExistsCaseInSense(const APath: string; out ActualFullDir: string) : boolean;
                        // Passed the Full Path (with or without trailing delim) to a Project Dir, rets F if not
                        // present, T if Dir exists. If it finds an lpi file, rets with FFilename, else empty string.
                        // WriteProjectToOpen will cause a download / copy of the files.
                        // Sets the Regional Var, ProjectToOpen if WriteProjectToOpen is true.
                        // Thats triggers a Lazarus Open when this window closes.
        function GetProjectFile(const APath: string; WriteProjectToOpen: boolean = false): boolean;
        procedure KeyWordSearch;
        function NewLVItem(const LView : TListView; const Proj, Path, KeyWords : string): TListItem;
                        // 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 download examples to 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

uses LazFileUtils, LCLType, fileutil, LazLogger;

{$R *.lfm}

{ TFormLazExam }


// ------------------------ L I S T   V I E W ----------------------------------

function TFormLazExam.NewLVItem(const LView : TListView; const Proj, Path, KeyWords : string): TListItem;
var
    TheItem : TListItem;
begin
    TheItem := LView.Items.Add;
    TheItem.Caption := Proj;
    TheItem.SubItems.Add(KeyWords);
    TheItem.SubItems.Add(Path);
    Result := TheItem;
end;

procedure TFormLazExam.ListView1SelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
begin
    ListView1Click(Sender);
end;

procedure TFormLazExam.LoadUpListView();
var
    Proj, Cat, Path, KeyW : string;
    Cnt : integer = 0;
    KeyList : TStringList = nil;
begin
    Screen.Cursor := crHourGlass;
    if EditSearch.text <> rsExSearchPrompt then begin
        KeyList := TStringList.Create;
        BuildSearchList(KeyList, EditSearch.Text);
    end;
    try
        if Ex.GetListData(Proj, Cat, Path, KeyW, True, KeyList) then begin
            NewLVItem(ListView1, Proj, Path, KeyW);
            inc(Cnt);
        end;
        while Ex.GetListData(Proj, Cat, Path, KeyW, False, KeyList) do begin
            NewLVItem(ListView1, Proj, Path, KeyW);
            inc(Cnt);
        end;
    finally
        if KeyList <> Nil then KeyList.Free;
        Screen.Cursor := crDefault;
    end;
    ButtonOpen.Enabled := false;
    ButtonDownLoad.enabled := false;
    Memo1.append(format(rsFoundExampleProjects, [Cnt]));
    StatusBar1.SimpleText := format(rsFoundExampleProjects, [Cnt]);
end;

procedure TFormLazExam.ListView1Click(Sender: TObject);
begin
    if  ListView1.Selected = nil then exit;         // White space below entries ....
    Memo1.Clear;
    Memo1.append(ListView1.Selected.SubItems[1]);
    Memo1.Append(Ex.GetDesc(ListView1.Selected.SubItems[1] + ListView1.Selected.Caption));
    // ListView1.Selected.Caption may be CamelCase from JSON.Name rather than path where we found it.
    ButtonDownLoad.enabled := true;
    //ButtonOpen.Enabled := GetProjectFile(ListView1.Selected.SubItems[1]);
    ButtonOpen.Enabled := GetProjectFile(Ex.MasterMeta(True) + ListView1.Selected.Caption);
end;

function TFormLazExam.CopyFiles(const Proj, SrcDir, DestDir : string) : boolean;
var
    STL : TStringList;
    St, FFname  : string;

    // The Right part of St starting with Proj
    function RightSide : string;
    var
        i : integer;
    begin
        result := '';
        i := St.Length;
        while i > 0 do begin
            if (PathDelim + lowercase(Proj) + PathDelim) = lowercase(copy(St, i, Proj.length+2)) then
                exit(copy(St, i, 1000));
            dec(i);
        end;
        debugln('TFormLazExam.CopyFiles - failed to find [' + Proj + '] in ' + St);
    end;

begin
    Result := False;
    STL := FindAllFiles(SrcDir, '*', True);
    try
        for St in STL do begin
            FFName := appendPathDelim(DestDir) + RightSide();
            if not ForceDirectoriesUTF8(extractFileDir(FFName)) then begin
                debugln('TFormLazExam.CopyFiles - Failed to force ' + extractFileDir(FFName));
                exit;
            end;
            if not copyfile(St, FFname, [cffOverwriteFile]) then begin
                debugln('TFormLazExam.CopyFiles - Failed to copy ' + St + ' to ' + FFName);
                exit;
            end;
        end;
    finally
        STL.Free;
    end;
    result := true;
end;

procedure TFormLazExam.ListView1DblClick(Sender: TObject);
begin
    if  ListView1.Selected = nil then exit;         // White space below entries ....
    if GetProjectFile(Ex.MasterMeta(True) + ListView1.Selected.Caption) 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;
    try
        if Ex <> nil then begin
            {$ifdef ONLINE_EXAMPLES}
            StatusBar1.SimpleText := rsExDownloadingProject;
            Application.ProcessMessages;
                EX.DownLoadDir(ListView1.Selected.SubItems[1]);
            StatusBar1.SimpleText := rsExProjectDownloadedTo + ' ' + Ex.MasterMeta(True)
                                                       + ListView1.Selected.Caption;
            {$else}
            StatusBar1.SimpleText := rsExCopyingProject;
            Application.ProcessMessages;
            if copyFiles(  ListView1.Selected.Caption,
                        ListView1.Selected.SubItems[1], Ex.MasterMeta(True)) then
                StatusBar1.SimpleText := rsExProjectCopiedTo + ' ' + Ex.MasterMeta(True)
            else StatusBar1.SimpleText := rsFailedToCopyFilesTo + ' ' + Ex.MasterMeta(True);
            {$endif}
        end;
    finally
        Screen.Cursor := crDefault;
    end;
    ButtonOpen.Enabled := GetProjectFile(Ex.MasterMeta(True) + ListView1.Selected.Caption);
end;

// --------------------- B U T T O N S -----------------------------------------

procedure TFormLazExam.ButtonOpenClick(Sender: TObject);
begin
    if GetProjectFile(Ex.MasterMeta(True) + ListView1.Selected.Caption, True)     // Sets ProjectToOpen on success
        and ProjectToOpen.IsEmpty then
            showmessage(rsExNoProjectFile)
        else
            close;
end;

procedure TFormLazExam.ButtonCloseClick(Sender: TObject);
begin
    Close;
end;

procedure TFormLazExam.ButtonDownloadClick(Sender: TObject);
begin
    ListView1DblClick(Sender);
end;

function TFormLazExam.GetProjectFile(const APath : string; WriteProjectToOpen : boolean = false) : boolean;
var
    Info : TSearchRec;
    RealDir : string;
    // The project dir name may not be a case match for the Project Name.
begin
    Result := DirExistsCaseInSense(APath, RealDir);
    if not (Result and WriteProjectToOpen) then exit;
    if FindFirst(RealDir + '*.lpi', faAnyFile, Info) = 0 then
        ProjectToOpen := RealDir + Info.Name
    else ProjectToOpen := '';
    FindClose(Info);
end;

// 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 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;

procedure TFormLazExam.CheckGroupCategoryItemClick(Sender: TObject; Index: integer);
begin
    if Ex = Nil then exit;
    Memo1.clear;
    ListView1.Clear;
    PrimeCatFilter();
    LoadUpListView();
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.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();
begin
      Memo1.clear;
      ListView1.Clear;
      Ex.KeyFilter := EditSearch.Text;
      LoadUpListView();
end;

procedure TFormLazExam.EditSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
    // Must do this here to stop LCL from selecting the text on VK_RETURN
    if Key = VK_RETURN then begin
      Key := 0;
      KeyWordSearch();
    end;
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);
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;
    ListView1.SortDirection:= sdDescending;
    ListView1.AutoWidthLastColumn:= True;
    ListView1.ViewStyle:= vsReport;
    ListView1.Column[0].AutoSize := true;
    ListView1.Column[1].AutoSize := true;
    ListView1.Column[2].Visible := false;
    ListView1.ReadOnly := True;
    EditSearch.text := rsExSearchPrompt;
    Ex := nil;
    // These are ObjectInspector set but I believe I cannot get OI literals set in a Package ??
    ButtonClose.Caption := rsExampleClose;
    ButtonDownload.Caption := rsExampleDownLoad;
    ButtonOpen.Caption := rsExampleOpen;
    CheckGroupCategory.Caption := rsExampleCategory;
    {$ifndef EXTESTMODE}
    IDEDialogLayoutList.ApplyLayout(Self);
    {$endif}
end;

procedure TFormLazExam.FormDestroy(Sender: TObject);
begin
    if Ex <> nil then Ex.Free;
end;

procedure TFormLazExam.FormShow(Sender: TObject);
var
    i : integer;
begin
    Memo1.clear;
    if Ex <> Nil then Ex.Free;
    StatusBar1.SimpleText := rsExSearchingForExamples;
    Ex := TExampleData.Create();
    Ex.GitDir     := GitDir;
    Ex.ExamplesHome := ExamplesHome;
    Ex.RemoteRepo := RemoteRepo;
    {$ifdef ONLINE_EXAMPLES}
    Ex.LoadExData(FromCacheFile);
    {$else}
    Ex.LoadExData(FromLazSrcTree);
    {$endif}
    if Ex.ErrorMsg <> '' then
        Showmessage(Ex.ErrorMsg)
    else begin
        ex.getCategoryData(CheckGroupCategory.Items);       // This sets the name of all categories in the CheckGroup
        for i := 0 to CheckGroupCategory.items.Count-1 do   // check all the categories we found.
            CheckGroupCategory.Checked[i] := true;
        ListView1.Clear;
        PrimeCatFilter();
        LoadUpListView();
    end;
    if EditSearch.Text <> rsExSearchPrompt then
        KeyWordSearch()
    else EditSearch.SetFocus;


end;

{   Must add a FormClose event 
	IDEDialogLayoutList.SaveLayout(Self);
}


end.