diff --git a/components/exampleswindow/exampleprojects.lpk b/components/exampleswindow/exampleprojects.lpk
index e4bcf06407..aaed5699e0 100644
--- a/components/exampleswindow/exampleprojects.lpk
+++ b/components/exampleswindow/exampleprojects.lpk
@@ -17,7 +17,7 @@
-
+
-
diff --git a/components/exampleswindow/languages/uconst.pot b/components/exampleswindow/languages/uconst.pot
index 7221b0b08f..6445c76247 100644
--- a/components/exampleswindow/languages/uconst.pot
+++ b/components/exampleswindow/languages/uconst.pot
@@ -13,6 +13,10 @@ msgstr ""
msgid "Close"
msgstr ""
+#: uconst.rsexamplecopy
+msgid "Copy to work area"
+msgstr ""
+
#: uconst.rsexampledownload
msgid "Download"
msgstr ""
@@ -37,6 +41,10 @@ msgstr ""
msgid "Example Projects"
msgstr ""
+#: uconst.rsexampleview
+msgid "View in Browser"
+msgstr ""
+
#: uconst.rsexcopyingproject
msgid "Copying Project ..."
msgstr ""
diff --git a/components/exampleswindow/languages/uconst.ru.po b/components/exampleswindow/languages/uconst.ru.po
index 65c8f85432..062396b1f1 100644
--- a/components/exampleswindow/languages/uconst.ru.po
+++ b/components/exampleswindow/languages/uconst.ru.po
@@ -23,6 +23,10 @@ msgstr "Категория"
msgid "Close"
msgstr "Закрыть"
+#: uconst.rsexamplecopy
+msgid "Copy to work area"
+msgstr ""
+
#: uconst.rsexampledownload
msgid "Download"
msgstr "Загрузить"
@@ -47,6 +51,10 @@ msgstr "Путь"
msgid "Example Projects"
msgstr "Примеры проектов"
+#: uconst.rsexampleview
+msgid "View in Browser"
+msgstr ""
+
#: uconst.rsexcopyingproject
msgid "Copying Project ..."
msgstr "Копирование проекта ..."
diff --git a/components/exampleswindow/uconst.pas b/components/exampleswindow/uconst.pas
index f9cc0f78ac..db18414477 100644
--- a/components/exampleswindow/uconst.pas
+++ b/components/exampleswindow/uconst.pas
@@ -24,6 +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...
+
resourcestring
@@ -50,6 +52,8 @@ resourcestring
rsExampleDownload = 'Download'; // "
rsExampleClose = 'Close'; // "
rsExampleCategory = 'Category'; // "
+ rsExampleCopy = 'Copy to work area'; // "
+ rsExampleView = 'View in Browser'; // "
// Settings Frame
rsDirWhereExamplesGo = 'Directory where Examples go';
diff --git a/components/exampleswindow/uexampledata.pas b/components/exampleswindow/uexampledata.pas
index a33a8944e4..271a6620f7 100644
--- a/components/exampleswindow/uexampledata.pas
+++ b/components/exampleswindow/uexampledata.pas
@@ -38,6 +38,10 @@ This unit does not interact directly with user but it does (hopefully not often)
generate some error messages that may need i18n. Only network errors have been done.
+WARNING - This unit includes code to download (and even upload) from a gitlab
+repo. At present its not being used and should get stripped out during linking.
+If it appears, long term, we are never to use the online approach, remove it !
+Code would be greatly simplified if we were not trying to also support OnLine.
}
{$mode ObjFPC}{$H+}
@@ -46,8 +50,8 @@ interface
uses Classes, SysUtils, fpjson, jsonparser ;
-const MetaFileExt = '.ex-meta';
-
+const
+ MetaFileExt = '.ex-meta'; // Extension of meta files.
type TExampleDataSource = ( FromGitlabTree, // Read all remote project meta files
FromLocalTree, // Read all local Git project meta files
@@ -57,10 +61,10 @@ type TExampleDataSource = ( FromGitlabTree, // Read all remote project meta f
type
PExRec=^TExRec;
TExRec = record
- EName : string; // CamelCase version of last part of FFName
+ EName : string; // CamelCase version of the example name, filenameonly of metadata file.
Category : string; // eg Beginner, NoDesign (read from remote data)
- Keywords : TStringList; // a list of (possibly multi-word) words
- FFName : string; // Path and filename of meta file. Maybe absolute or relative
+ Keywords : TStringList; // a list of (possibly multi-word) words, nil acceptable
+ FFName : string; // Path and filename of meta file. Maybe absolute or relative, no extension
Desc : string; // 1..many lines of description
end;
@@ -102,13 +106,13 @@ type
ErrorString : String;
ExList : TExampleList;
GetListDataIndex : integer;
- LazConfigDir : string; // dir (eg OPM) under which we might find more Examples
+
// Gets a Full URL and returns with St containing content, usually as JSON
function Downloader(URL: string; out SomeString: String): boolean;
// Does a binary safe download of a file, URL will get repositary info prepended
// and file ends up in FullDest which should be a full path and filename.
function DownLoadFile(const URL, FullDest: string): boolean;
- //function EscJSON(InStr: string): string;
+ //function EscJSON(InStr: string): string;
function ExtractArrayFromJSON(const Field: string; jItem: TJSONData; STL: TStringList): boolean;
// Passed a json block, returns the indicated field, cannot handle arrays.
// Don't rely on its base64 decoding a binary file, see DownLoadFile() instead.
@@ -117,14 +121,10 @@ type
Res: string; Base64: boolean = false): boolean;
function GetLazDir: string;
- // The returned date string down to seconds includes time zone in ISO8601
- // eg 2022-01-09T11:56:51+11:00
- function GetLocalTime: ANSIstring;
-
// Receives a pretested JSON (not just a field) containing metadata of an Example
// Returns false if data missing, drops msg to console about bad field.
// Path may be relative or absolute (ie starting with '/' or '\'). Ones without
- // a leading slash are remote, ie gitlab. Ones with a slash should be resolable
+ // a leading slash are remote, ie gitlab. Ones with a slash should be resolvable
// locally. Note when indexing a local git tree, relative must be used, ie top of
// git tree. In this mode of course, the entry will not be resolvable locally.
function InsertJSONData(jItem: TJSONData; FFName: string; AName: string = '' ): boolean;
@@ -142,12 +142,11 @@ type
function ScanOneTree(Path: string; out St: string): boolean;
procedure fSetErrorString(Er : string);
- function WriteMasterMeta(FFileName: string): boolean;
-
public
+ LazConfigDir : string; // Where Lazarus keeps it config.
RemoteRepo : string; // eg https://gitlab.com/api/v4/projects/32480729/repository/
- ExamplesHome : string; // dir where we will save a working copy of examples too, usually LazConfigDir
+ 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
GitDir : string; // where we look for a local git repo containg examples
KeyFilter : string; // A list of words, possibly grouped by " to filter Keywords
@@ -155,25 +154,31 @@ type
// 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;
- // 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.
+ // Returns a path (with trailing delim) to where we will putting our downloaded
+ // or copied Example Projects. It includes the working dir. Usually something
+ // like /examples_work_dir/ but is user configurable via Laz Settings.
+ function ExampleWorkingDir: string;
+ // 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; GetFirst: boolean;
KeyList: TStringList = nil): boolean;
// Passed a created TStrings that it clears and fills in with all know categories
function getCategoryData(const CatList : TStrings) : boolean;
+ // Pass the relative path and fileNameOnly of metafile, no extension (?)
function GetDesc(const FFname: string): string;
constructor Create;
procedure LoadExData(DataSource: TExampleDataSource);
destructor Destroy; override;
procedure DumpExData();
- // A service method, called by the GUI to download a project/
- // Pass it a full example remote dir (eg Beginner/Laz_Hello/).
+ // A service method, called by the GUI to download a project/
+ // Pass it a full example remote dir (eg Beginner/Laz_Hello/).
function DownLoadDir(const FExampDir: string): boolean;
function Count : integer;
- function MasterMeta(DirOnly: boolean = false): string; // returns the full Master Metafile name
function ExtractFieldsFromJSON(const JStr: string; out EName, Cat, Keys, Desc,
Error: string): boolean;
+ // Rets T if passed name is already in list as a project name
+ function DoesNameExist(AName : string) : boolean;
property ErrorMsg : string read ErrorString write FSetErrorString;
class function EscJSON(InStr: string): string;
end;
@@ -190,13 +195,13 @@ uses LCLProc,
ssockets, fpopenssl,
lazfileutils, fileutil,
jsonscanner, // these are the FPC JSON tools
- base64
- , laz2_DOM, laz2_XMLRead // just to get LazarusDirectory, remove if we find a better way !
- {$ifdef LINUX},Unix {$endif} // We call a ReReadLocalTime();
- {, IDEOptionsIntf}, LazIDEIntf;
+ base64,
+ laz2_DOM, laz2_XMLRead // just to get LazarusDirectory, remove if we find a better way !
+ {, IDEOptionsIntf} ;
const
- LastUpDate = 'LastUpDate'; // Name of JSON item were we store last update
+ LastUpDate = 'LastUpDate'; // Name of JSON item were we store last update date
+
{ A URL starts with eg 'https://gitlab.com/api/v4/projects/32480729/repository/'
It contains a multidigit number that identifies the gitlab project. The number is a
@@ -311,17 +316,13 @@ begin
Debugln(ErrorString);
end;
-// Rets a path to where we will putting our downloaded or copied ex projects.
-// At present, this is the /downloaded_examples/
-// if not true, returns the FFName of the master meta file, same place.
-function TExampleData.MasterMeta(DirOnly : boolean = false) : string;
+function TExampleData.ExampleWorkingDir() : string;
begin
- //result := LazConfigDir + cExamplesDir + pathdelim;
- result := AppendPathDelim(ExamplesHome);
- if not DirOnly then
- result := Result + 'master' + MetaFileExt;
+ result := AppendPathDelim(ExamplesHome) + cExamplesDir + PathDelim ;
end;
+
+
function TExampleData.ExtractFieldsFromJSON(const JStr: string; out EName, Cat,
Keys, Desc, Error: string): boolean;
var
@@ -355,6 +356,16 @@ begin
end;
end;
+function TExampleData.DoesNameExist(AName: string): boolean;
+var
+ P : PExRec;
+begin
+ for P in ExList do
+ if lowercase(AName) = lowercase(P^.EName) then
+ exit(True);
+ result := False;
+end;
+
function TExampleData.TestJSON(const J : string; out Error, Cat : string) : boolean;
var
jData, jItem : TJSONData;
@@ -402,6 +413,7 @@ var
// index : integer;
KeyWords : TStringList;
begin
+ Result := False;
ExtractFromJSON('Category', jItem, Cat); // An empty Cat is acceptable but undesirable.
if not ExtractFromJSON('Description', jItem, Desc) then exit(False);
KeyWords := TStringList.Create;
@@ -411,7 +423,11 @@ begin
else
if not ExtractFromJSON('Name', jItem, AnotherName) then
AnotherName := '';
- Result := ExList.InsertData(Cat, Desc, FFName, AnotherName, KeyWords);
+ if DoesNameExist(AnotherName) then begin
+ debugln('TExampleData.InsertJSONData - WARNING duplicate Example Name found = '
+ + AnotherName + ' ' + FFName);
+ end
+ else Result := ExList.InsertData(Cat, Desc, FFName, AnotherName, KeyWords);
if not Result then KeyWords.Free; // false means its not gone into list so our responsibility go free
end;
@@ -427,7 +443,6 @@ begin
STL := FindAllFiles(Path, '*' + MetaFileExt, True);
try
for St in STL do begin
- //debugln('TExampleData.ScanLocalTree 1 Looking at ' + St);
if pos('master' + MetaFileExt, St) > 0 then continue; // don't do master if you stumble across one
if pos(cExamplesDir, St) > 0 then continue; // thats our downloaded location
FileContent := TStringList.Create;
@@ -498,41 +513,39 @@ end;
constructor TExampleData.Create();
begin
ExList := TExampleList.Create;
- LazConfigDir := appendPathDelim(LazarusIDE.GetPrimaryConfigPath);
end;
procedure TExampleData.LoadExData(DataSource: TExampleDataSource);
begin
// If we are loading the data from either the remote gitlab tree or a local
// git tree, we save the master file.
- if not DirectoryExists(MasterMeta(True)) then
- if not ForceDirectory(MasterMeta(True)) then exit;
+ if not DirectoryExists(ExampleWorkingDir()) then
+ if not ForceDirectory(ExampleWorkingDir()) then exit;
case DataSource of
FromGitLabTree : begin // too slow to be useful
ScanRemoteTree('');
- WriteMasterMeta('master' + MetaFileExt); // save in working dir
end;
FromLocalTree : begin // not used in Lazarus Package
if ScanLocalTree(GitDir, False) then // This should leave relative paths, suitable to upload to gitlab
- WriteMasterMeta(GitDir + 'master' + MetaFileExt); // save in git tree ready to upload.
end;
FromLazSrcTree : begin
ScanLocalTree(GetLazDir(), True); // Scan the Lazarus SRC tree
- ScanLocalTree(LazConfigDir, True); // Get, eg, any OPM Examples
+ ScanLocalTree(ExamplesHome, True); // Get, eg, any OPM Examples
+ // in the above line, we assume if user has moved Examples, then they will have OPM there too.
end;
FromCacheFile : begin
- if not LoadCacheFile(MasterMeta()) then begin
- DownLoadFile('master' + MetaFileExt, MasterMeta());
- LoadCacheFile(MasterMeta()); // ToDo : Test that worked
+ if not LoadCacheFile(ExampleWorkingDir()+ 'master' + MetaFileExt) then begin
+ DownLoadFile('master' + MetaFileExt, ExampleWorkingDir()+ 'master' + MetaFileExt);
+ LoadCacheFile(ExampleWorkingDir()+ 'master' + MetaFileExt); // ToDo : Test that worked
end;
- ScanLocalTree(LazConfigDir, True); // Get, eg, any OPM Examples
+ ScanLocalTree(ExamplesHome, True); // Get, eg, any OPM Examples
end;
end;
// if ExList.Count = 0 then begin
- debugln('TExampleData.LoadExData - found examples = ' + inttostr(ExList.Count));
- debugln('Lazarus Dir (ie source tree) = ' + GetLazDir());
- debugln('Lazarus Config Dir = ' + LazConfigDir);
- debugln('Examples Home Dir = ' + ExamplesHome);
+// debugln('TExampleData.LoadExData - found examples = ' + inttostr(ExList.Count));
+// debugln('Lazarus Dir (ie source tree) = ' + GetLazDir());
+// debugln('Lazarus Config Dir = ' + LazConfigDir);
+// debugln('Examples Home Dir = ' + ExamplesHome);
// end;
end;
@@ -605,7 +618,7 @@ var
Node, Node1 : TDOMNode;
begin
Result := '';
- ReadXMLFile(Doc, LazConfigDir + 'environmentoptions.xml');
+ ReadXMLFile(Doc, LazConfigDir + 'environmentoptions.xml'); // even in EXTESTMODE LazConfigDir should be valid
Node1 := Doc.DocumentElement.FindNode('EnvironmentOptions');
if Node1 <> nil then begin
Node := Node1.FindNode('LazarusDirectory');
@@ -616,30 +629,7 @@ begin
// will be wrong anyway. Further research is indicated.
end;
Doc.free;
- debugln('TExampleData.GetLazDir = ' + Result);
-end;
-
-function TExampleData.GetLocalTime: ANSIstring;
-var
- ThisMoment : TDateTime;
- Res : ANSIString;
- Off : longint;
-begin
- {$ifdef LINUX}
- ReReadLocalTime(); // in case we are near daylight saving time changeover
- {$endif}
- ThisMoment:=Now;
- Result := FormatDateTime('YYYY-MM-DD',ThisMoment) + 'T'
- + FormatDateTime('hh:mm:ss',ThisMoment);
- Off := GetLocalTimeOffset();
- if (Off div -60) >= 0 then Res := '+'
- else Res := '-';
- if abs(Off div -60) < 10 then Res := Res + '0';
- Res := Res + inttostr(abs(Off div -60)) + ':';
- if (Off mod 60) = 0 then
- Res := res + '00'
- else Res := Res + inttostr(abs(Off mod 60));
- Result := Result + res;
+ // debugln('TExampleData.GetLazDir = ' + Result);
end;
class function TExampleData.EscJSON(InStr : string) : string;
@@ -651,38 +641,6 @@ begin
Result := Result.Replace(#09, '', [rfReplaceAll] ); // tab
end;
-function TExampleData.WriteMasterMeta(FFileName : string) : boolean;
-var
- i : integer;
- STL : TStringList;
- St, StIndexed : string;
-begin
- STL := TStringList.Create;
- StL.Add('{'#10'"' + LastUpDate + '":"' + GetLocalTime() +'",');
-
- for i := 0 to ExList.Count-1 do begin
- StL.Add('"' + EscJSON(ExList.Items[i]^.FFname) + '" : {'); // Must be unique
- StL.Add(' "Name" : "' + EscJSON(ExList.Items[i]^.EName) + '",');
- StL.Add(' "Category" : "' + EscJSON(ExList.Items[i]^.Category) + '",');
- St := '';
- for StIndexed in ExList.Items[i]^.Keywords do
- St := St + '"' + StIndexed + '",';
- if St.Length > 0 then delete(St, St.Length, 1); // Remove trailing comma
- StL.Add(' "Keywords" : [' + St + '],');
- StL.Add(' "Description" : "' + EscJSON(ExList.Items[i]^.Desc) + '"},');
- end;
- if STL.Count > 1 then begin
- St := STL[STL.Count-1];
- delete(St, St.Length, 1);
- STL[STL.Count-1] := St;
- end;
- Stl.Add('}');
- deletefile(FFileName); // ToDo : test its there first and then test delete worked
- STL.SaveToFile(FFileName);
- STL.Free;
- Result := fileexists(FFileName);
-end;
-
// ******************** Methods relating to using the data *******************
@@ -749,15 +707,14 @@ function TExampleData.GetDesc(const FFname: string): string;
var
P : PExRec;
begin
+ Result := '';
for P in ExList do begin
if (lowercase(P^.FFname) = lowercase(FFname)+MetaFileExt) then begin // extension must remain lower case
exit(P^.Desc);
end;
end;
- Result := '';
- debugln('TExampleData.GetDesc - did not find Desc for ' + FFname);
- debugln('Spelling of Name must match directory name (case insensitive)');
- ExList.DumpList('TExampleData.GetDesc', True);
+ debugln('TExampleData.GetDesc - ERROR did not find Desc for ' + FFname);
+ //ExList.DumpList('TExampleData.GetDesc', True);
end;
@@ -772,9 +729,9 @@ begin
try
result := ScanRemoteTree(FExampDir, STL);
for St in STL do begin
- if not DirectoryExistsUTF8(MasterMeta(True) + ExtractFileDir(St)) then
- ForceDirectory(MasterMeta(True) + ExtractFileDir(St)); // ToDo : but that might fail
- DownLoadFile(St, MasterMeta(True) + St);
+ if not DirectoryExistsUTF8(ExampleWorkingDir() + ExtractFileDir(St)) then
+ ForceDirectory(ExampleWorkingDir() + ExtractFileDir(St)); // ToDo : but that might fail
+ DownLoadFile(St, ExampleWorkingDir() + St);
end;
finally
STL.Free;
diff --git a/components/exampleswindow/uintf.pas b/components/exampleswindow/uintf.pas
index 7e7d830ae6..d34b983d45 100644
--- a/components/exampleswindow/uintf.pas
+++ b/components/exampleswindow/uintf.pas
@@ -41,8 +41,8 @@ begin
Config := GetIDEConfigStorage(cConfigFileName, true);
try
Result := Config.GetValue('Examples/Directory',
- AppendPathDelim(LazarusIDE.GetPrimaryConfigPath) +
- AppendPathDelim(cExamplesDir));
+ AppendPathDelim(LazarusIDE.GetPrimaryConfigPath));
+ // + AppendPathDelim(cExamplesDir));
finally
Config.Free;
@@ -64,6 +64,7 @@ begin
try
FormLazExam.ExamplesHome := GetExamplesHomeDir();
FormLazExam.RemoteRepo := cRemoteRepository;
+ FormLazExam.LazConfigDir := AppendPathDelim(LazarusIDE.GetPrimaryConfigPath);
FormLazExam.ShowModal;
ProjectFFile := FormLazExam.ProjectToOpen;
finally
diff --git a/components/exampleswindow/ulaz_examples.lfm b/components/exampleswindow/ulaz_examples.lfm
index 4b8cb9af7a..ebbe700e66 100644
--- a/components/exampleswindow/ulaz_examples.lfm
+++ b/components/exampleswindow/ulaz_examples.lfm
@@ -1,7 +1,7 @@
object FormLazExam: TFormLazExam
- Left = 562
+ Left = 55
Height = 574
- Top = 168
+ Top = 143
Width = 781
Caption = 'Prototype Lazarus Examples Window'
ClientHeight = 574
@@ -18,7 +18,7 @@ object FormLazExam: TFormLazExam
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CheckGroupCategory
Left = 5
- Height = 216
+ Height = 209
Top = 225
Width = 771
Anchors = [akTop, akLeft, akRight, akBottom]
@@ -71,8 +71,8 @@ object FormLazExam: TFormLazExam
AnchorSideRight.Control = ButtonClose
AnchorSideBottom.Control = StatusBar1
Left = 10
- Height = 105
- Top = 446
+ Height = 112
+ Top = 439
Width = 577
Anchors = [akTop, akLeft, akRight, akBottom]
AutoFill = True
@@ -88,6 +88,7 @@ object FormLazExam: TFormLazExam
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2
Columns = 2
+ OnDblClick = CheckGroupCategoryDblClick
OnItemClick = CheckGroupCategoryItemClick
TabOrder = 3
end
@@ -151,10 +152,10 @@ object FormLazExam: TFormLazExam
AnchorSideLeft.Control = ButtonClose
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
- AnchorSideBottom.Control = ButtonClose
+ AnchorSideBottom.Control = ButtonView
Left = 597
- Height = 35
- Top = 481
+ Height = 28
+ Top = 467
Width = 179
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Right = 5
@@ -167,8 +168,8 @@ object FormLazExam: TFormLazExam
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = StatusBar1
Left = 597
- Height = 35
- Top = 516
+ Height = 28
+ Top = 523
Width = 179
Anchors = [akRight, akBottom]
BorderSpacing.Right = 5
@@ -182,8 +183,8 @@ object FormLazExam: TFormLazExam
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonDownload
Left = 597
- Height = 35
- Top = 446
+ Height = 28
+ Top = 439
Width = 179
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Right = 5
@@ -191,4 +192,19 @@ object FormLazExam: TFormLazExam
OnClick = ButtonOpenClick
TabOrder = 8
end
+ object ButtonView: TButton
+ AnchorSideLeft.Control = ButtonClose
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ AnchorSideBottom.Control = ButtonClose
+ Left = 597
+ Height = 28
+ Top = 495
+ Width = 179
+ Anchors = [akLeft, akRight, akBottom]
+ BorderSpacing.Right = 5
+ Caption = 'ButtonView'
+ OnClick = ButtonViewClick
+ TabOrder = 9
+ end
end
diff --git a/components/exampleswindow/ulaz_examples.pas b/components/exampleswindow/ulaz_examples.pas
index cac6ebc4d1..48c61ae254 100644
--- a/components/exampleswindow/ulaz_examples.pas
+++ b/components/exampleswindow/ulaz_examples.pas
@@ -25,8 +25,9 @@ Notes -
David Bannon, Feb 2022
}
{$mode objfpc}{$H+}
+{x$define EXTESTMODE}
-{x$define ONLINE_EXAMPLES}
+{X$define ONLINE_EXAMPLES}
interface
@@ -44,6 +45,7 @@ type
{ TFormLazExam }
TFormLazExam = class(TForm)
+ ButtonView: TButton;
ButtonDownload: TButton;
ButtonClose: TButton;
ButtonOpen: TButton;
@@ -57,6 +59,8 @@ type
procedure ButtonCloseClick(Sender: TObject);
procedure ButtonDownloadClick(Sender: TObject);
procedure ButtonOpenClick(Sender: TObject);
+ procedure ButtonViewClick(Sender: TObject);
+ procedure CheckGroupCategoryDblClick(Sender: TObject);
procedure CheckGroupCategoryItemClick(Sender: TObject; Index: integer);
procedure EditSearchExit(Sender: TObject);
procedure EditSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -68,8 +72,11 @@ type
procedure ListView1SelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
private
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.
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;
// 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.
@@ -78,14 +85,15 @@ type
// 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;
+ function NewLVItem(const LView: TListView; const Proj, Path, KeyWords,
+ Cat: 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.
+ 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.
@@ -97,7 +105,7 @@ var
implementation
-uses LazFileUtils, LCLType, fileutil, LazLogger;
+uses LazFileUtils, LCLType, fileutil, LazLogger, LCLIntf;
{$R *.lfm}
@@ -106,7 +114,7 @@ uses LazFileUtils, LCLType, fileutil, LazLogger;
// ------------------------ L I S T V I E W ----------------------------------
-function TFormLazExam.NewLVItem(const LView : TListView; const Proj, Path, KeyWords : string): TListItem;
+function TFormLazExam.NewLVItem(const LView : TListView; const Proj, Path, KeyWords, Cat : string): TListItem;
var
TheItem : TListItem;
begin
@@ -114,6 +122,7 @@ begin
TheItem.Caption := Proj;
TheItem.SubItems.Add(KeyWords);
TheItem.SubItems.Add(Path);
+ TheItem.SubItems.Add(Cat);
Result := TheItem;
end;
@@ -135,11 +144,11 @@ begin
end;
try
if Ex.GetListData(Proj, Cat, Path, KeyW, True, KeyList) then begin
- NewLVItem(ListView1, Proj, Path, KeyW);
+ NewLVItem(ListView1, Proj, Path, KeyW, Cat);
inc(Cnt);
end;
while Ex.GetListData(Proj, Cat, Path, KeyW, False, KeyList) do begin
- NewLVItem(ListView1, Proj, Path, KeyW);
+ NewLVItem(ListView1, Proj, Path, KeyW, Cat);
inc(Cnt);
end;
finally
@@ -148,6 +157,7 @@ begin
end;
ButtonOpen.Enabled := false;
ButtonDownLoad.enabled := false;
+ ButtonView.enabled := false;
Memo1.append(format(rsFoundExampleProjects, [Cnt]));
StatusBar1.SimpleText := format(rsFoundExampleProjects, [Cnt]);
end;
@@ -157,58 +167,37 @@ begin
if ListView1.Selected = nil then exit; // White space below entries ....
Memo1.Clear;
Memo1.append(ListView1.Selected.SubItems[1]);
+ Memo1.append('');
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;
+ ButtonView.enabled := true;
//ButtonOpen.Enabled := GetProjectFile(ListView1.Selected.SubItems[1]);
- ButtonOpen.Enabled := GetProjectFile(Ex.MasterMeta(True) + ListView1.Selected.Caption);
+ ButtonOpen.Enabled := GetProjectFile(Ex.ExampleWorkingDir() + 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
+ ButtonDownloadClick(self);
+ ButtonOpenClick(self);
+end;
+
+// --------------------- B U T T O N S -----------------------------------------
+
+procedure TFormLazExam.ButtonOpenClick(Sender: TObject);
+begin
+ if GetProjectFile(Ex.ExampleWorkingDir() + ListView1.Selected.Caption, True) // Sets ProjectToOpen on success
+ and ProjectToOpen.IsEmpty then
+ showmessage(rsExNoProjectFile)
+ else
+ close;
+end;
+
+procedure TFormLazExam.ButtonDownloadClick(Sender: TObject);
begin
if ListView1.Selected = nil then exit; // White space below entries ....
- if GetProjectFile(Ex.MasterMeta(True) + ListView1.Selected.Caption) 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;
@@ -227,26 +216,22 @@ begin
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);
+ ListView1.Selected.SubItems[1], Ex.ExampleWorkingDir()) then
+ StatusBar1.SimpleText := rsExProjectCopiedTo + ' ' + Ex.ExampleWorkingDir()
+ + ListView1.Selected.Caption
+ else StatusBar1.SimpleText := rsFailedToCopyFilesTo + ' ' + Ex.ExampleWorkingDir();
{$endif}
end;
finally
Screen.Cursor := crDefault;
end;
- ButtonOpen.Enabled := GetProjectFile(Ex.MasterMeta(True) + ListView1.Selected.Caption);
+ ButtonOpen.Enabled := GetProjectFile(Ex.ExampleWorkingDir() + ListView1.Selected.Caption);
+
end;
-// --------------------- B U T T O N S -----------------------------------------
-
-procedure TFormLazExam.ButtonOpenClick(Sender: TObject);
+procedure TFormLazExam.ButtonViewClick(Sender: TObject);
begin
- if GetProjectFile(Ex.MasterMeta(True) + ListView1.Selected.Caption, True) // Sets ProjectToOpen on success
- and ProjectToOpen.IsEmpty then
- showmessage(rsExNoProjectFile)
- else
- close;
+ OpenURL(BaseURL + ListView1.Selected.SubItems[2] + '/' + ListView1.Selected.Caption);
end;
procedure TFormLazExam.ButtonCloseClick(Sender: TObject);
@@ -254,16 +239,54 @@ begin
Close;
end;
-procedure TFormLazExam.ButtonDownloadClick(Sender: TObject);
+function TFormLazExam.CopyFiles(const Proj, SrcDir, DestDir : string) : boolean;
+var
+ STL : TStringList;
+ St : string;
+ ChopOff : integer;
begin
- ListView1DblClick(Sender);
+ ChopOff := length(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)); // DRB
+ 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];
+end;
+
+procedure TFormLazExam.CheckGroupCategoryItemClick(Sender: TObject; Index: integer);
+begin
+ if Ex = Nil then exit;
+ Memo1.clear;
+ ListView1.Clear;
+ PrimeCatFilter();
+ LoadUpListView();
+end;
+
+// ---------------------- Setting Project to Open ------------------------------
+
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.
+ // We are looking here at dir under example_work_area so some match is expected
begin
Result := DirExistsCaseInSense(APath, RealDir);
if not (Result and WriteProjectToOpen) then exit;
@@ -273,8 +296,6 @@ begin
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;
@@ -298,15 +319,6 @@ begin
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 --------------------------
@@ -411,7 +423,12 @@ 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}
ButtonDownload.Caption := rsExampleDownLoad;
+ {$else}
+ ButtonDownload.Caption := rsExampleCopy;
+ {$endif}
+ ButtonView.Caption := rsExampleView;
ButtonOpen.Caption := rsExampleOpen;
CheckGroupCategory.Caption := rsExampleCategory;
{$ifndef EXTESTMODE}
@@ -435,6 +452,7 @@ begin
Ex.GitDir := GitDir;
Ex.ExamplesHome := ExamplesHome;
Ex.RemoteRepo := RemoteRepo;
+ EX.LazConfigDir := LazConfigDir;
{$ifdef ONLINE_EXAMPLES}
Ex.LoadExData(FromCacheFile);
{$else}