paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-13 13:49:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fixes to the new Examples Window package, View Button, relax Proj Dir name rule, minor things.

Browse Source
This commit is contained in:
dbannon 2022-04-09 11:05:36 +00:00 committed by Juha Manninen
parent 745d9ca108
commit 6e75bb3141
8 changed files with 215 additions and 203 deletions

2
components/exampleswindow/exampleprojects.lpk
View File

@ -17,7 +17,7 @@
</CompilerOptions>
<Description Value="Example Projects."/>
<License Value="GPL"/>
<Version Minor="7"/>
<Version Minor="8"/>
<Files>
<Item>
<Filename Value="uintf.pas"/>

8
components/exampleswindow/languages/uconst.pot
View File

@ -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 ""

8
components/exampleswindow/languages/uconst.ru.po
View File

@ -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 "Копирование проекта ..."

4
components/exampleswindow/uconst.pas
View File

@ -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';

185
components/exampleswindow/uexampledata.pas
View File

@ -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 <lazConf>/
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 <lazConfig>/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 <lazconfig>/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;

5
components/exampleswindow/uintf.pas
View File

@ -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

40
components/exampleswindow/ulaz_examples.lfm
View File

@ -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

166
components/exampleswindow/ulaz_examples.pas
View File

@ -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}