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

ExamplesWindow: Use GetParsedLazarusDirectory from OptionsIntf instead of reading XML file. Arrange uses sections. Hide some warnings.

Browse Source
This commit is contained in:
Juha 2022-12-04 09:46:25 +02:00
parent 24c3a3a248
commit e723acfe03
5 changed files with 59 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
components/exampleswindow/exwinsettings.pas
View File

@ -1,4 +1,4 @@
unit exwinsettings;
unit ExWinSettings;
{
**********************************************************************
This file is part of a Lazarus Package, Examples Window.
@ -20,8 +20,18 @@ working space is. Easily extended. David Bannon, Feb 2022
interface
uses
Classes, SysUtils, Forms, Controls, StdCtrls, EditBtn, IDEOptionsIntf,
IDEOptEditorIntf;
Classes, SysUtils,
// LazUtils
LazConfigStorage, LazFileUtils, LazLoggerBase,
// LCL
Controls, StdCtrls, EditBtn, Dialogs,
// BuildIntf
IDEOptionsIntf, baseIDEIntf,
// IdeIntf
LazIDEIntf, IDEOptEditorIntf,
//
UConst;
{ TExWinSettings }
@ -33,7 +43,7 @@ type
private
public
constructor Create(const pbReadRegFile: boolean);
constructor Create(const {%H-}pbReadRegFile: boolean);
destructor Destroy; override;
class function GetGroupCaption: String; override;
class function GetInstance: TAbstractIDEOptions; override;
@ -71,9 +81,6 @@ var
implementation
uses Dialogs, LazLogger, UConst, baseIDEIntf, LazConfigStorage, LazFileUtils,
LazIDEIntf;
{$R *.lfm}
{ TExWinSettings }
@ -126,7 +133,7 @@ end;
function TExWinSettingsFrame.GetTitle: String;
begin
Result := rsExampleProjects;
Result := rsGeneral;
end;
procedure TExWinSettingsFrame.ReadSettings(AOptions: TAbstractIDEOptions);

1
components/exampleswindow/uconst.pas
View File

@ -57,6 +57,7 @@ resourcestring
rsExampleView = 'View in Browser'; // "
// Settings Frame
rsGeneral = 'General';
rsDirWhereExamplesGo = 'Directory where Examples go';
// ------- rsExampleData

68
components/exampleswindow/uexampledata.pas
View File

@ -1,4 +1,4 @@
unit uexampledata;
unit uExampleData;
{
**********************************************************************
@ -48,7 +48,15 @@ Code would be greatly simplified if we were not trying to also support OnLine.
interface
uses Classes, SysUtils, fpjson, jsonparser ;
uses
Classes, SysUtils, fpjson, jsonparser, jsonscanner, // these are the FPC JSON tools
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;
const
MetaFileExt = '.ex-meta'; // Extension of meta files.
@ -119,8 +127,6 @@ 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;
function GetLazDir: string;
// 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
@ -187,19 +193,11 @@ type
implementation
uses LCLProc,
uConst,
httpprotocol, // for http encoding
fphttpclient, // determines a dependency on FPC 3.2.0 or later. Must for https downloads
opensslsockets,
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 !
uses
uConst;
const
LastUpDate = 'LastUpDate'; // Name of JSON item were we store last update date
//const
// 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/'
@ -540,10 +538,10 @@ begin
if ScanLocalTree(GitDir, False) then // This should leave relative paths, suitable to upload to gitlab
end;
FromLazSrcTree : begin
ScanLocalTree(GetLazDir(), 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.
end;
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.
end;
FromCacheFile : begin
if not LoadCacheFile(ExampleWorkingDir()+ 'master' + MetaFileExt) then begin
DownLoadFile('master' + MetaFileExt, ExampleWorkingDir()+ 'master' + MetaFileExt);
@ -555,7 +553,7 @@ begin
ExList.Sort(@CategorySorter);
// if ExList.Count = 0 then begin
// debugln('TExampleData.LoadExData - found examples = ' + inttostr(ExList.Count));
// debugln('Lazarus Dir (ie source tree) = ' + GetLazDir());
// debugln('Lazarus Dir (ie source tree) = ' + IDEEnvironmentOptions.GetParsedLazarusDirectory);
// debugln('Lazarus Config Dir = ' + LazConfigDir);
// debugln('Examples Home Dir = ' + ExamplesHome);
// end;
@ -616,34 +614,6 @@ begin
Result := true;
end;
{ environmentoptions.xml
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<EnvironmentOptions>
...
<LazarusDirectory Value="/home/dbannon/bin/Lazarus/lazarus-main"> .... }
function TExampleData.GetLazDir() : string; // Todo : make direct call
var
Doc : TXMLDocument;
Node, Node1 : TDOMNode;
begin
Result := '';
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');
if Node <> nil then
Result := AppendPathDelim(Resolvedots(Node.Attributes.GetNamedItem('Value').NodeValue));
// Apparently sometimes Lazarus puts a relative path in envopts.xml - danger here is
// that if Lazarus now has a working dir different from when the path was written, it
// will be wrong anyway. Further research is indicated.
end;
Doc.free;
// debugln('TExampleData.GetLazDir = ' + Result);
end;
class function TExampleData.EscJSON(InStr : string) : string;
begin
Result := InStr.Replace('\', '\\', [rfReplaceAll]);

19
components/exampleswindow/uintf.pas
View File

@ -17,19 +17,22 @@ This unit provides the interface between Lazarus and the Package.
interface
uses
Classes,
//LCL,
LCLType,
//IDEIntf,
MenuIntf, IDECommands, ToolBarIntf, IDEOptEditorIntf;
Classes, SysUtils,
// LazUtils
LazFileUtils, LazConfigStorage, LazLoggerBase,
// LCL,
LCLType,
// BuildIntf
BaseIDEIntf, IDEOptionsIntf,
// IdeIntf
LazIDEIntf, MenuIntf, IDECommands, ToolBarIntf, IDEOptEditorIntf;
procedure Register;
implementation
uses uLaz_Examples, uConst, lazlogger,
LazIDEintf, LazFileUtils, BuildIntf, ExWinSettings,
baseIDEIntf, IDEOptionsIntf, LazConfigStorage, SysUtils;
uses
uLaz_Examples, uConst, ExWinSettings;
// Note : IDEEnvironmentOptions.GetParsedLazarusDirectory is the Lazarus STC tree.

25
components/exampleswindow/ulaz_examples.pas
View File

@ -25,19 +25,23 @@ Notes -
David Bannon, Feb 2022
}
{$mode objfpc}{$H+}
{$define EXTESTMODE}
{.$define EXTESTMODE}
{X$define ONLINE_EXAMPLES}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
ExtCtrls, Interfaces, uexampledata, uConst
Classes, SysUtils,
// LazUtils
LazFileUtils, fileutil, LazLoggerBase,
// LCL
LCLType, LCLIntf, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
ExtCtrls,
{$ifndef EXTESTMODE}
, IDEWindowIntf
IDEWindowIntf,
{$endif}
;
uexampledata, uConst;
type
@ -60,18 +64,17 @@ type
procedure ButtonOpenClick(Sender: TObject);
procedure ButtonViewClick(Sender: TObject);
procedure CheckGroupCategoryDblClick(Sender: TObject);
procedure CheckGroupCategoryItemClick(Sender: TObject; Index: integer);
procedure CheckGroupCategoryItemClick(Sender: TObject; {%H-}Index: integer);
procedure EditSearchChange(Sender: TObject);
procedure EditSearchExit(Sender: TObject);
procedure EditSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure EditSearchKeyUp(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ListView1Click(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
procedure ListView1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ListView1SelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
procedure ListView1KeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure ListView1SelectItem(Sender: TObject; {%H-}Item: TListItem; {%H-}Selected: Boolean);
private
procedure BuildSearchList(SL: TStringList; const Term: AnsiString);
// Copies the passed ex dir to a dir named for the Proj.
@ -107,8 +110,6 @@ var
implementation
uses LazFileUtils, LCLType, fileutil, LazLogger, LCLIntf;
{$R *.lfm}
{ TFormLazExam }