paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 16:39:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

New Examples GUI Window as an IDE plugin package by David Bannon.

Browse Source
This commit is contained in:
Juha 2022-03-06 13:34:37 +02:00
parent 31328882fb
commit a6ce4d91e2
10 changed files with 2227 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
components/exampleswindow/exampleprojects.lpk Normal file
View File

@ -0,0 +1,60 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="5">
<PathDelim Value="\"/>
<Name Value="exampleprojects"/>
<Type Value="RunAndDesignTime"/>
<Author Value=" David Bannon"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CustomOptions Value="$(IDEBuildOptions)"/>
</Other>
</CompilerOptions>
<Description Value="Example Projects."/>
<License Value="GPL"/>
<Version Major="1"/>
<Files>
<Item>
<Filename Value="uintf.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="uIntf"/>
</Item>
<Item>
<Filename Value="uconst.pas"/>
<UnitName Value="uConst"/>
</Item>
<Item>
<Filename Value="ulaz_examples.pas"/>
<UnitName Value="uLaz_Examples"/>
</Item>
<Item>
<Filename Value="uexampledata.pas"/>
<UnitName Value="uexampledata"/>
</Item>
<Item>
<Filename Value="exwinsettings.pas"/>
<UnitName Value="exwinsettings"/>
</Item>
</Files>
<RequiredPkgs>
<Item>
<PackageName Value="IDEIntf"/>
</Item>
<Item>
<PackageName Value="FCL"/>
</Item>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
</Package>
</CONFIG>

23
components/exampleswindow/exampleprojects.pas Normal file
View File

@ -0,0 +1,23 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit exampleprojects;
{$warn 5023 off : no warning about unused units}
interface
uses
uIntf, uConst, uLaz_Examples, uexampledata, exwinsettings,
LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('uIntf', @uIntf.Register);
end;
initialization
RegisterPackage('exampleprojects', @Register);
end.

50
components/exampleswindow/exwinsettings.lfm Normal file
View File

@ -0,0 +1,50 @@
object ExWinSettingsFrame: TExWinSettingsFrame
Left = 0
Height = 240
Top = 0
Width = 320
ClientHeight = 240
ClientWidth = 320
TabOrder = 0
DesignLeft = 567
DesignTop = 426
object ButtonDefault: TButton
AnchorSideLeft.Control = DirectoryEdit1
AnchorSideTop.Control = DirectoryEdit1
AnchorSideTop.Side = asrBottom
Left = 20
Height = 25
Top = 159
Width = 75
BorderSpacing.Top = 10
Caption = 'Default'
OnClick = ButtonDefaultClick
TabOrder = 0
end
object DirectoryEdit1: TDirectoryEdit
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 20
Height = 29
Top = 120
Width = 280
Directory = 'DirectoryEdit1'
ShowHidden = False
ButtonWidth = 23
NumGlyphs = 1
Anchors = [akLeft, akRight]
BorderSpacing.Left = 20
BorderSpacing.Right = 20
MaxLength = 0
TabOrder = 1
Text = 'DirectoryEdit1'
end
object Label1: TLabel
Left = 27
Height = 21
Top = 91
Width = 287
Caption = 'Directory where examples are saved'
end
end

193
components/exampleswindow/exwinsettings.pas Normal file
View File

@ -0,0 +1,193 @@
unit exwinsettings;
{
**********************************************************************
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 makes a frame that is poked into Lazarus's Options Tree. At present
all it gets back is the user's preference as to where the Example Projects
working space is. Easily extended. David Bannon, Feb 2022
}
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, StdCtrls, EditBtn, IDEOptionsIntf,
IDEOptEditorIntf;
{ TExWinSettings }
// -------- The Options Group ID, and, perhaps, a place in the Tree View -------
type
TExWinSettings = class(TAbstractIDEEnvironmentOptions) // needed by options group.
private
public
constructor Create(const pbReadRegFile: boolean);
destructor Destroy; override;
class function GetGroupCaption: String; override;
class function GetInstance: TAbstractIDEOptions; override;
procedure DoAfterWrite({%H-}Restore: boolean); override;
end;
// ------ This is the Frame displayed when user clicks the Tree View note ------
type
{ TExWinSettingsFrame }
TExWinSettingsFrame = class(TAbstractIDEOptionsEditor)
ButtonDefault: TButton;
DirectoryEdit1: TDirectoryEdit;
Label1: TLabel;
procedure ButtonDefaultClick(Sender: TObject);
private
DefaultExamplesHome : string;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
function GetTitle: String; override;
procedure ReadSettings({%H-}AOptions: TAbstractIDEOptions); override;
procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override;
class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
procedure WriteSettings({%H-}AOptions: TAbstractIDEOptions); override;
procedure RestoreSettings({%H-}AOptions: TAbstractIDEOptions); override;
end;
var
ExWindowOptionsGroup : integer;
ExWinOptionsFrameID : integer;
implementation
uses Dialogs, LazLogger, UConst, baseIDEIntf, LazConfigStorage, LazFileUtils,
LazIDEIntf;
{$R *.lfm}
{ TExWinSettings }
constructor TExWinSettings.Create(const pbReadRegFile: boolean);
begin
// inherited Create;
end;
destructor TExWinSettings.Destroy;
begin
inherited Destroy;
end;
class function TExWinSettings.GetGroupCaption: String;
begin
Result := rsExampleProjects;
end;
class function TExWinSettings.GetInstance: TAbstractIDEOptions;
begin
//result := TAbstractIDEOptions(self); // Nope, it does not like that !
result := nil;
end;
procedure TExWinSettings.DoAfterWrite(Restore: boolean);
begin
inherited DoAfterWrite(Restore);
end;
{ TExWinSettingsFrame }
procedure TExWinSettingsFrame.ButtonDefaultClick(Sender: TObject);
begin
DirectoryEdit1.Text := DefaultExamplesHome;
end;
constructor TExWinSettingsFrame.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
DefaultExamplesHome := AppendPathDelim(LazarusIDE.GetPrimaryConfigPath)
+ AppendPathDelim(cExamplesDir);
end;
destructor TExWinSettingsFrame.Destroy;
begin
inherited Destroy;
end;
function TExWinSettingsFrame.GetTitle: String;
begin
Result := rsExampleProjects;
end;
procedure TExWinSettingsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
var
Config: TConfigStorage;
begin
try
Config := GetIDEConfigStorage(cConfigFileName, true);
try
DirectoryEdit1.Text := Config.GetValue('Examples/Directory', DefaultExamplesHome);
finally
Config.Free;
end;
except
on E: Exception do begin
DebugLn('TExWinSettingsFrame.ReadSettings Loading ' + cConfigFileName + ' failed: ' + E.Message);
end;
end;
end;
// Maybe the initial settings before we have a config file ? Labels and Captions.
procedure TExWinSettingsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
begin
Label1.Caption := rsDirWhereExamplesGo;
end;
class function TExWinSettingsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
begin
Result := nil;
end;
// Gets called whenever user opens Options tree.
procedure TExWinSettingsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
var
Config: TConfigStorage;
begin
try
Config := GetIDEConfigStorage(cConfigFileName,false);
try
Config.SetDeleteValue('Examples/Directory',DirectoryEdit1.Text, DefaultExamplesHome);
finally
Config.Free;
end;
except
on E: Exception do begin
DebugLn('TExWinSettingsFrame.ReadSettings Saving ' + cConfigFileName + ' failed: ' + E.Message);
end;
end;
end;
procedure TExWinSettingsFrame.RestoreSettings(AOptions: TAbstractIDEOptions);
begin
inherited RestoreSettings(AOptions);
end;
initialization
ExWindowOptionsGroup := GetFreeIDEOptionsGroupIndex(GroupEditor);
RegisterIDEOptionsGroup(ExWindowOptionsGroup, TExWinSettings, False); // F cos I get Index from above line. I think.
end.

66
components/exampleswindow/uconst.pas Normal file
View File

@ -0,0 +1,66 @@
unit uConst;
{
**********************************************************************
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 provides the Example Projects package with a few constants and
a number of string literals that will i18n translation.
}
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
const
cRemoteRepository = 'https://gitlab.com/api/v4/projects/32866275/repository/';
// Immediate Local dir name under which we copy or
cExamplesDir = 'examples_work_dir'; // download examples to. Carefull about simplifying it
cConfigFileName = 'exampleprojectscfg.xml';
resourcestring
// --------- Multiple units
rsExampleProjects = 'Example Projects';
// ---------- uLaz_Examples
rsExSearchPrompt = 'Search Here';
rsExNoProjectFile = 'Maybe no project file ?';
rsFoundExampleProjects = 'Found %d Example Projects';
rsRefreshExistingExample = 'Refresh Existing Example ?';
rsExDownloadingProject = 'Downloading Project...';
rsExCopyingProject = 'Copying Project...';
rsExProjectDownloadedTo = 'Project Downloaded to'; // followed by a full path name
rsExProjectCopiedTo = 'Project Copied to'; // followed by a full path name
rsExampleName = 'Name'; // Column title
rsExamplePath = 'Path'; // "
rsExampleKeyWords = 'Key Words'; // "
rsExSearchingForExamples = 'Searching for Examples';
rsFailedToCopyFilesTo = 'Failed to copy files to'; // Followed by a dir were we, apparently, cannot write
// These are ObjectInspector set but I believe I cannot get OI literals i18n in a Package ??
rsExampleOpen = 'Open'; // Button Caption
rsExampleDownload = 'Download'; // "
rsExampleClose = 'Close'; // "
rsExampleCategory = 'Category'; // "
// Settings Frame
rsDirWhereExamplesGo = 'Directory where Examples go';
// ------- rsExampleData
// Most literals in uExampleData are for debugging only and very unlikely to be
// seen by the end user. But a couple of network related ones may need i18n -
rsExNetWorkError = 'GitLab NetWork Error'; // Followed by system error msg
implementation
end.

1006
components/exampleswindow/uexampledata.pas Normal file
View File

File diff suppressed because it is too large Load Diff

106
components/exampleswindow/uintf.pas Normal file
View File

@ -0,0 +1,106 @@
unit uIntf;
{
**********************************************************************
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 provides the interface between Lazarus and the Package.
}
{$mode objfpc}{$H+}
interface
uses
Classes,
//LCL,
LCLType,
//IDEIntf,
MenuIntf, IDECommands, ToolBarIntf, IDEOptEditorIntf;
procedure Register;
implementation
uses uLaz_Examples, uConst, lazlogger,
LazIDEintf, LazFileUtils, BuildIntf, ExWinSettings,
baseIDEIntf, IDEOptionsIntf, LazConfigStorage, SysUtils;
// Note : IDEEnvironmentOptions.GetParsedLazarusDirectory is the Lazarus STC tree.
function GetExamplesHomeDir() : string;
var
Config: TConfigStorage;
begin
try
Config := GetIDEConfigStorage(cConfigFileName, true);
try
Result := Config.GetValue('Examples/Directory',
AppendPathDelim(LazarusIDE.GetPrimaryConfigPath) +
AppendPathDelim(cExamplesDir));
finally
Config.Free;
end;
except
on E: Exception do begin
DebugLn('Examples UIntf GetExamplesDirectory Loading ' + cConfigFileName + ' failed: ' + E.Message);
Result := IDEEnvironmentOptions.GetParsedLazarusDirectory;
end;
end;
end;
procedure IDEMenuSectionClicked(Sender: TObject);
var
ProjectFFile : string;
begin
FormLazExam := TFormLazExam.Create(nil);
try
FormLazExam.ExamplesHome := GetExamplesHomeDir();
FormLazExam.RemoteRepo := cRemoteRepository;
FormLazExam.ShowModal;
ProjectFFile := FormLazExam.ProjectToOpen;
finally
FormLazExam.Free;
FormLazExam := nil;
end;
if ProjectFFile <> '' then
LazarusIDE.DoOpenProjectFile(ProjectFFile, [ofProjectLoading]);
end;
procedure Register;
var
IDEShortCutX: TIDEShortCut;
IDECommandCategory: TIDECommandCategory;
IDECommand: TIDECommand;
begin
IDEShortCutX := IDEShortCut(VK_E, [ssCtrl, ssAlt], VK_UNKNOWN, []);
IDECommandCategory := IDECommandList.FindCategoryByName('ToolMenu');
IDECommand := nil;
if IDECommandCategory <> nil then
begin
IDECommand := RegisterIDECommand(IDECommandCategory, rsExampleProjects, rsExampleProjects, IDEShortCutX, nil, @IDEMenuSectionClicked);
if IDECommand <> nil then
RegisterIDEButtonCommand(IDECommand);
end;
RegisterIDEMenuCommand(itmSecondaryTools, rsExampleProjects, rsExampleProjects + ' ...', nil, @IDEMenuSectionClicked, IDECommand, 'pkg_oep');
RegisterIDEMenuCommand(ComponentPalettePageDropDownExtraEntries, rsExampleProjects, rsExampleProjects + ' ...', nil, @IDEMenuSectionClicked, nil, 'pkg_oep');
ExWinOptionsFrameID := RegisterIDEOptionsEditor(ExWindowOptionsGroup, TExWinSettingsFrame, 9999)^.Index; // AIndex = what ???
end;
initialization
finalization
end.

194
components/exampleswindow/ulaz_examples.lfm Normal file
View File

@ -0,0 +1,194 @@
object FormLazExam: TFormLazExam
Left = 562
Height = 574
Top = 168
Width = 781
Caption = 'Prototype Lazarus Examples Window'
ClientHeight = 574
ClientWidth = 781
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
LCLVersion = '2.3.0.0'
object Memo1: TMemo
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Splitter2
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CheckGroupCategory
Left = 5
Height = 216
Top = 225
Width = 771
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 5
BorderSpacing.Right = 5
BorderSpacing.Bottom = 5
Lines.Strings = (
'Memo1'
)
ParentShowHint = False
ReadOnly = True
ScrollBars = ssAutoVertical
TabOrder = 2
end
object ListView1: TListView
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Splitter2
Left = 5
Height = 178
Hint = 'Click for Info, Double Click to download'
Top = 37
Width = 776
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 5
BorderSpacing.Top = 5
BorderSpacing.Bottom = 5
Columns = <
item
end
item
end
item
Width = 661
end>
ParentShowHint = False
ReadOnly = True
ShowHint = True
TabOrder = 1
OnClick = ListView1Click
OnDblClick = ListView1DblClick
OnSelectItem = ListView1SelectItem
end
object CheckGroupCategory: TCheckGroup
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = ButtonOpen
AnchorSideRight.Control = ButtonClose
AnchorSideBottom.Control = StatusBar1
Left = 10
Height = 105
Top = 446
Width = 577
Anchors = [akTop, akLeft, akRight, akBottom]
AutoFill = True
BorderSpacing.Left = 10
BorderSpacing.Right = 10
Caption = 'Category'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2
Columns = 2
OnItemClick = CheckGroupCategoryItemClick
TabOrder = 3
end
object Splitter2: TSplitter
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = ListView1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Memo1
Cursor = crVSplit
Left = 0
Height = 5
Top = 220
Width = 781
Align = alNone
Anchors = [akLeft, akRight]
ResizeAnchor = akTop
end
object Panel1: TPanel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 0
Height = 32
Top = 0
Width = 781
Anchors = [akTop, akLeft, akRight]
ClientHeight = 32
ClientWidth = 781
TabOrder = 0
TabStop = True
object EditSearch: TEdit
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
Left = 10
Height = 29
Hint = 'Searches for Keywords'
Top = 1
Width = 415
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 9
BorderSpacing.Right = 25
OnExit = EditSearchExit
OnKeyUp = EditSearchKeyUp
ParentShowHint = False
ShowHint = True
TabOrder = 0
Text = 'EditSearch'
end
end
object StatusBar1: TStatusBar
Left = 0
Height = 23
Top = 551
Width = 781
Panels = <>
end
object ButtonDownload: TButton
AnchorSideLeft.Control = ButtonClose
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonClose
Left = 597
Height = 35
Top = 481
Width = 179
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Right = 5
Caption = 'Download'
OnClick = ButtonDownloadClick
TabOrder = 6
end
object ButtonClose: TButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = StatusBar1
Left = 597
Height = 35
Top = 516
Width = 179
Anchors = [akRight, akBottom]
BorderSpacing.Right = 5
Caption = 'Close'
OnClick = ButtonCloseClick
TabOrder = 7
end
object ButtonOpen: TButton
AnchorSideLeft.Control = ButtonClose
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonDownload
Left = 597
Height = 35
Top = 446
Width = 179
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Right = 5
Caption = 'Open'
OnClick = ButtonOpenClick
TabOrder = 8
end
end

58
components/exampleswindow/ulaz_examples.lpi Normal file
View File

@ -0,0 +1,58 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="ulaz_examples"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="IDEIntf"/>
</Item>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="ulaz_examples.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="FormLazExam"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uLaz_Examples"/>
</Unit>
<Unit>
<Filename Value="uexampledata.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="ulaz_examples"/>
</Target>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
</CONFIG>

471
components/exampleswindow/ulaz_examples.pas Normal file
View File

@ -0,0 +1,471 @@
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();
debugln('TFormLazExam.CopyFiles Forcing an ExamplesHome of ' + extractFileDir(FFname));
debugln('TFormLazExam.CopyFiles Copying a file to ' + FFname);
debugln('TFormLazExam.CopyFiles DestDir = ' + DestDir);
debugln('TFormLazExam.CopyFiles ExamplesHome = ' + ExamplesHome);
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.