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

ExamplesWindow: Better model to find Examples. Issue #40190, patch by dbannon.

Browse Source
This commit is contained in:
Juha 2023-04-07 11:16:57 +03:00
parent f54ee297ee
commit dfbd6d519a
2 changed files with 174 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

226
components/exampleswindow/uexampledata.pas
View File

@ -8,18 +8,20 @@ unit uExampleData;
for details about the license.
**********************************************************************
This unit is the backend that provides an List that contains details of Lazarus
This unit is the backend that provides a List that contains details of Lazarus
Example Projects. It might get its data from one of three different places,
* The LazarusDir and the LazarusConfigDir.
* A locally cached master meta file Disabled as of Feb 2022
* A remote gitlab repository (ie, if the above is not present), Disabled as of Feb 2022
* The LazarusDir, thats the SRC dir, examples shipped with Lazarus.
* Any Packages installed in Lazarus, looks in <pcp>packagefiles.xml
( A locally cached master meta file Disabled as of Feb 2022 )
( A remote gitlab repository (ie, if the above is not present), Disabled as of Feb 2022 )
This list can be used to populate the Lazarus Examples Window or used during the
markup of existing Lazarus Projects. The unit is used by the Lazarus Package and
a simple tool used to manage the meta data files.
-- PATHS --
-- PATHS (n.a. unless online mode enabled ) --
This only really applies in the Out of Lazarus Package usage. David Bannon, Feb 2022
@ -37,7 +39,6 @@ so, no leading slash and all paths are relative to the top of the local git repo
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 !
@ -45,7 +46,7 @@ Code would be greatly simplified if we were not trying to also support OnLine.
}
{$mode ObjFPC}{$H+}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
interface
uses
@ -53,20 +54,20 @@ uses
httpprotocol, // for http encoding
fphttpclient, // determines a dependency on FPC 3.2.0 or later. Must for https downloads
ssockets, fpopenssl, base64,
// LazUtils
LazFileUtils, FileUtil, LazLoggerBase,
// BuildIntf
IDEOptionsIntf;
Laz2_XMLRead, Laz2_DOM, LazFileUtils, FileUtil, LazLoggerBase
{$ifndef EXTESTMODE}
, IDEOptionsIntf
{$endif};
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
FromCacheFile, // Load data from Local Cache File
FromLazSrcTree); // Searches the Lazarus Src Tree, eg ~/examples; ~/components
type
TExampleDataSource = (FromGitlabTree, // Read all remote project meta files
FromLocalTree, // Read all local Git project meta files
FromCacheFile, // Load data from Local Cache File
FromLazSrcTree); // Searches the Lazarus Src Tree, eg ~/examples; ~/components
PExRec=^TExRec;
TExRec = record
EName : string; // CamelCase version of the example name, filenameonly of metadata file.
@ -76,8 +77,8 @@ type
Desc : string; // 1..many lines of description
end;
type
{ TExampleList }
TExampleList = class(TFPList)
private
@ -95,8 +96,7 @@ type
function IsInKeywords(St : string; AnIndex : integer) : boolean;
property Items[Index: integer]: PExRec read Get; default;
end;
end;
{ Note - the above list is used to generate a master.ex-meta file that might be added
the the gitlab repo. So, dir seperators MUST be /. On Windows, they will be read
@ -105,8 +105,6 @@ I think we will declare they are always /, when reading local filesystems on
Windows, must convert during the insert into list stage. }
type
{ TExampleData }
TExampleData = class
@ -115,6 +113,15 @@ type
ExList : TExampleList;
GetListDataIndex : integer;
// Passed full file name of the packagesfiles.xml file in PCP, returns
// with the list filled with paths to some directory above the package
// lpk file being a suitable place to start searching for Examples.
procedure CollectThirdPartyPackages(PkgFilesXML: String; AList: TStrings);
// Returns true if it has altered FullPkgFileName to where we can expect to find Examples
function GetThirdPartyDir(var FullPkgFileName: string): boolean;
// Triggers a search of installed packages other than ones from LazSrcTree
// It assumes such packages are listed in <PCP>/packagefiles.xml
procedure ScanThirdPartyPkg;
// 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
@ -127,6 +134,7 @@ type
function ExtractFromJSON(const Field, data: string; Base64: boolean=false) : string;
function ExtractFromJSON(const Field: string; const jItem: TJSONData; out
Res: string; Base64: boolean = false): boolean;
// 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
@ -149,7 +157,7 @@ type
procedure fSetErrorString(Er : string);
public
LazConfigDir : string; // Where Lazarus keeps it config.
LazConfigDir : string; // Where Lazarus keeps it config. Comes from uLaz_Examples, uIntf, LazarusIDE.GetPrimaryConfigPath
RemoteRepo : string; // eg https://gitlab.com/api/v4/projects/32480729/repository/
ExamplesHome : string; // dir above examples_working_dir where we copy examples to, set by uintf.pas, usually <lazConf>/
@ -192,13 +200,8 @@ type
implementation
uses
uConst;
//const
// LastUpDate = 'LastUpDate'; // Name of JSON item were we store last update date
uConst {$ifdef EXTESTMODE}, Main_Examples{$endif} ;
{ 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
@ -207,7 +210,6 @@ web pages as "Project ID", group id will not work. A full URL might look like th
https://gitlab.com/api/v4/projects/32866275/repository/files/Utility%2FExScanner%2Fproject1.ico?ref=main
}
// =============================================================================
// T E X A M P L E L I S T
//==============================================================================
@ -301,6 +303,133 @@ end;
// T E X A M P L E D A T A
// =============================================================================
// PkgFilesXML is the full path of the file "packagefiles.xml" which resides in the Lazarus primary config path.
procedure TExampleData.CollectThirdPartyPackages(PkgFilesXML: String; AList: TStrings);
// By WP, see https://forum.lazarus.freepascal.org/index.php/topic,62552.msg473109.html#msg473109
var
doc: TXMLDocument;
userPkgLinks: TDOMNode;
pkgNode: TDOMNode;
filenameNode: TDOMNode;
filenameAttr: TDOMNode;
St : String;
begin
if not FileExists(PkgFilesXML) then
exit;
ReadXMLFile(doc, PkgFilesXML);
try
userPkgLinks := doc.DocumentElement.FindNode('UserPkgLinks');
if userPkgLinks = nil then
exit;
pkgNode := userPkgLinks.FirstChild;
while pkgNode <> nil do begin
filenameNode := pkgNode.FindNode('Filename');
if filenameNode <> nil then begin
filenameAttr := filenameNode.Attributes.GetNamedItem('Value');
if filenameAttr <> nil then begin
// wp's code delivered ffn of installed project LPK file, I need a directory above any Examples
St := filenameAttr.Nodevalue;
ForcePathDelims(St); // ExtractFileDir has problems with unexpected pathdelim....
if GetThirdPartyDir(St) then
AList.Add(St);
end;
end;
pkgNode := pkgNode.NextSibling;
end;
finally
doc.Free;
end;
end;
{ First we look for a tag like <ExampleDirectory="../."/> just below <Package....
If we find it, good, thats authorative, exit.
Failing above, start with the full path and name to the LPK file, remove the filename.
We try and find Package->CompilerOptions->SearchPaths->OtherUnitFiles, if its
not present or empty, we assume that the LPK file is at the top of package tree.
Else we remove the rightmost dir item from the full path for each ..<PathSep> we
find in the OtherUnitFiles value. }
function TExampleData.GetThirdPartyDir(var FullPkgFileName: string): boolean;
var
doc: TXMLDocument;
NodeA, NodeB: TDOMNode;
ADir : string = '';
DebugThis : boolean = False; // ToDo : remove these debug statements after suitable testing
begin
Result := true;
if DebugThis then debugln('TExampleData.GetThirdParty - looking at [' + FullPkgFileName + ']');
if not FileExists(FullPkgFileName) then
exit(false); // only real error return code
ReadXMLFile(doc, FullPkgFileName); // Hmm, xml exceptions ?
try
FullPkgFileName := ExtractFileDir(FullPkgFileName); // Remove the LPK name, might be best we can do.
NodeB := doc.DocumentElement.FindNode('Package');
if NodeB = nil then exit;
NodeA := NodeB.FindNode('ExampleDirectory');
if NodeA <> nil then begin
if DebugThis then debugln('ExampleDir Mode');
NodeB := NodeA.Attributes.GetNamedItem('Value');
if NodeB <> nil then // Leave existing path in FullPkgFileName, ie assumes LPK file is level or above examples
ADir := NodeB.NodeValue;
end else begin
NodeA := NodeB.FindNode('CompilerOptions'); // OK, so, no ExampleDir ? we will try for OtherUnitFiles, might be OK
if NodeA = nil then exit;
NodeB := NodeA.FindNode('SearchPaths');
if NodeB = nil then exit;
NodeA := NodeB.FindNode('OtherUnitFiles'); // if we don't find OtherUnitFiles, we return with path of the LPK file and hope for the best
if NodeA = nil then exit;
NodeB := NodeA.Attributes.GetNamedItem('Value');
if NodeB = nil then exit; // Element is present but has no value ?
ADir := NodeB.NodeValue;
end;
if debugThis then debugln('TExampleData.GetThirdParty - ADir [' + ADir + ']');
while ADir.StartsWith('..') do begin // all we are interested in is the number of leading "../"
ADir := ADir.Remove(0, 3);
FullPkgFileName := ExtractFileDir(FullPkgFileName);
end;
Result := True;
if DebugThis then debugln('TExampleData.GetThirdParty - Returning OtherUnitFiles [' + FullPkgFileName + ']');
finally
doc.free;
end;
end;
(* An LPK file might look like this -
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="KControlsLaz"/>
<Type Value="RunAndDesignTime"/>
<Author Value="Tomas Krysl"/>
<ExampleDirectory Value="../."> // Maybe not there ....
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="..\..\source"/>
<OtherUnitFiles Value="..\..\source"/> // Maybe not there, maybe wrong for our purpose
*)
procedure TExampleData.ScanThirdPartyPkg();
var
STL : TStringList;
i : integer;
begin
STL := TStringList.Create;
STL.Sorted := true;
STL.Duplicates := dupIgnore;
try
CollectThirdPartyPackages(LazConfigDir + 'packagefiles.xml', STL);
for i := 0 to Stl.Count -1 do
ScanLocalTree(STL[i], True);
finally
STL.Free;
end;
end;
// Address of this function is passed to a list sort call. We sort on category, Beginners at top
function CategorySorter( Item1: Pointer; Item2: Pointer) : Integer;
begin
@ -315,7 +444,7 @@ end;
procedure TExampleData.fSetErrorString(Er : string);
begin
ErrorString := Er;
Debugln(ErrorString);
Debugln('Warning : [TExampleData]' + ErrorString);
end;
function TExampleData.ExampleWorkingDir() : string;
@ -324,7 +453,6 @@ begin
end;
function TExampleData.ExtractFieldsFromJSON(const JStr: string; out EName, Cat,
Keys, Desc, Error: string): boolean;
var
@ -416,8 +544,10 @@ var
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);
if not ExtractFromJSON('Category', jItem, Cat) then // An empty field here is acceptable but undesirable.
debugln('Hint: (Lazarus) [TExampleData.InsertJSONData] Metadata file has no category : ' + FFName);
if not ExtractFromJSON('Description', jItem, Desc) then
debugln('Hint: (Lazarus) [TExampleData.InsertJSONData] Metadata file has no description : ' + FFName);
{$ifdef WINDOWS}
Desc := Desc.Replace(#10, #13#10, [rfReplaceAll]);
{$endif}
@ -428,12 +558,11 @@ begin
else
if not ExtractFromJSON('Name', jItem, AnotherName) then
AnotherName := '';
if DoesNameExist(AnotherName) then begin
debugln('TExampleData.InsertJSONData - WARNING duplicate Example Name found = '
+ AnotherName + ' ' + FFName);
end
if DoesNameExist(AnotherName) then
debugln('Warning: [TExampleData.InsertJSONData] duplicate Example Name found = '
+ AnotherName + ' ' + FFName)
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
if not Result then KeyWords.Free; // false means its not gone into list so our responsibility to free
end;
// Scans local tree below 'Path' looking for any likely Example Metadata files.
@ -456,12 +585,12 @@ begin
try
FileContent.LoadFromFile(St); // That is contents of one individual metadata file
if PathAbs then
Result := ReadSingleJSON(FileContent, St)
else Result := ReadSingleJSON(FileContent, copy(St, Path.Length+1, 1000));
Result := ReadSingleJSON(FileContent, St) // Calls InsertJSONData() if successful
else Result := ReadSingleJSON(FileContent, copy(St, Path.Length+1, 1000)); // "
if not Result then begin
debugln('Offending file is ' + St);
debugln(ErrorMsg);
//exit(False); // process all the good ones anyway, hope thats good....
//exit(False); // process all the good ones anyway, hope thats OK....
end;
finally
FileContent.Free;
@ -485,13 +614,13 @@ begin
jItem := jData.Items[0];
except
on E: EJSONParser do begin
ErrorMsg := 'ERROR EJSONParser- invalid JSON in ' + PathToStore
ErrorMsg := 'Error in EJSONParser- invalid JSON in ' + PathToStore
+ ' ' + E.Message;
jData := Nil; // Appears nothing is allocated if error ?
exit(false);
end;
on E: EScannerError do begin // Thats in jsonscanner unit, Must doc on Wiki !!!
ErrorMsg := 'ERROR EScanner- invalid JSON in ' + PathToStore // this is typically a single \
ErrorMsg := 'Error in EScanner- invalid JSON in ' + PathToStore // this is typically a single \
+ ' ' + E.Message;
jData := Nil; // Appears nothing is allocated if error ?
exit(false);
@ -538,9 +667,8 @@ begin
if ScanLocalTree(GitDir, False) then // This should leave relative paths, suitable to upload to gitlab
end;
FromLazSrcTree : begin
ScanLocalTree(IDEEnvironmentOptions.GetParsedLazarusDirectory, True); // Scan the Lazarus SRC tree
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.
ScanLocalTree(IDEEnvironmentOptions.GetParsedLazarusDirectory, True); // Scan the Lazarus SRC tree
ScanThirdPartyPkg(); // Get, eg, any OPM Examples or ones manually installed by user.
end;
FromCacheFile : begin
if not LoadCacheFile(ExampleWorkingDir()+ 'master' + MetaFileExt) then begin
@ -551,12 +679,6 @@ begin
end;
end;
ExList.Sort(@CategorySorter);
// if ExList.Count = 0 then begin
// debugln('TExampleData.LoadExData - found examples = ' + inttostr(ExList.Count));
// debugln('Lazarus Dir (ie source tree) = ' + IDEEnvironmentOptions.GetParsedLazarusDirectory);
// debugln('Lazarus Config Dir = ' + LazConfigDir);
// debugln('Examples Home Dir = ' + ExamplesHome);
// end;
end;

1
components/exampleswindow/ulaz_examples.pas
View File

@ -21,7 +21,6 @@ extension of ex-meta.
David Bannon, Dec 2022
}
{$mode objfpc}{$H+}
{X$define EXTESTMODE}
{X$define ONLINE_EXAMPLES}