diff --git a/README.md b/README.md
index a0a0911a..1ff33433 100644
--- a/README.md
+++ b/README.md
@@ -3,8 +3,7 @@ Coedit
Coedit is a simple IDE for the [D2](http://dlang.org) lang. (**Co** mpile & **Edit**).
-
-
+ 
Current features
----------------
@@ -17,7 +16,7 @@ Current features
- module symbol list.
- static libraries manager.
- search and replace.
-- "todo comment" analyzer.
+- "todo comments" analyzer.
- user-defined tools powered by a string interpolation system.
- [D Completion Daemon](https://github.com/Hackerpilot/DCD) integration for completion proposal and source code hints.
- mini file browser.
@@ -31,7 +30,7 @@ Project information
- status: alpha 11.
- license: MIT.
- programmed in Object Pascal with [Lazarus & FPC](http://www.lazarus.freepascal.org) as IDE & compiler.
-- based on *DMD* (the alternative backends, LDC or GDC, are not supported).
+- based on *DMD* (the alternative compilers, LDC or GDC, are not supported).
Setup & test
------------
diff --git a/cetodo/cetodo.d b/cetodo/cetodo.d
index 90b58ff7..b368030e 100644
--- a/cetodo/cetodo.d
+++ b/cetodo/cetodo.d
@@ -77,13 +77,13 @@ private struct TodoItem
if (prior.length) try auto i = to!long(prior);
catch(Exception e) prior = "";
- fFields[TodoField.filename] = fname;
- fFields[TodoField.line] = line;
- fFields[TodoField.text] = text;
- fFields[TodoField.category] = cat;
- fFields[TodoField.assignee] = ass;
- fFields[TodoField.priority] = prior;
- fFields[TodoField.status] = status;
+ fFields[TodoField.filename] = fname.idup;
+ fFields[TodoField.line] = line.idup;
+ fFields[TodoField.text] = text.idup;
+ fFields[TodoField.category] = cat.idup;
+ fFields[TodoField.assignee] = ass.idup;
+ fFields[TodoField.priority] = prior.idup;
+ fFields[TodoField.status] = status.idup;
}
/**
diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi
index 01f20e84..875c529b 100644
--- a/lazproj/coedit.lpi
+++ b/lazproj/coedit.lpi
@@ -140,7 +140,7 @@
-
+
@@ -353,6 +353,16 @@
+
+
+
+
+
+
+
+
+
+
diff --git a/lazproj/coedit.lpr b/lazproj/coedit.lpr
index 9c17110d..3c51c451 100644
--- a/lazproj/coedit.lpr
+++ b/lazproj/coedit.lpr
@@ -8,7 +8,7 @@ uses
{$ENDIF}{$ENDIF}
Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, ce_observer, ce_libman,
ce_tools, ce_dcd, ce_main, ce_writableComponent, ce_options, ce_symstring,
- ce_staticmacro, ce_icons;
+ ce_staticmacro, ce_icons, ce_dubwrap, ce_inspectors;
{$R *.res}
diff --git a/src/ce_dcd.pas b/src/ce_dcd.pas
index d9a4dcb3..88e5f86d 100644
--- a/src/ce_dcd.pas
+++ b/src/ce_dcd.pas
@@ -16,7 +16,7 @@ type
* Completion, hints and declaration finder automatically work on the current
* document: ICEMultiDocObserver.
*)
- TCEDcdWrapper = class(TWritableComponent, ICEProjectObserver, ICEMultiDocObserver)
+ TCEDcdWrapper = class(TWritableLfmTextComponent, ICEProjectObserver, ICEMultiDocObserver)
private
fTempLines: TStringList;
//fPortNum: Word;
diff --git a/src/ce_dmdwrap.pas b/src/ce_dmdwrap.pas
index 5ce6ca86..564692bc 100644
--- a/src/ce_dmdwrap.pas
+++ b/src/ce_dmdwrap.pas
@@ -5,7 +5,7 @@ unit ce_dmdwrap;
interface
uses
- classes, sysutils, process, asyncprocess, ce_common;
+ classes, sysutils, process, asyncprocess, ce_common, ce_inspectors;
(*
@@ -39,18 +39,18 @@ type
TDocOpts = class(TOptsGroup)
private
fGenDoc: boolean;
- fDocDir: string;
+ fDocDir: TCEPathname;
fGenJson: boolean;
- fJsonFname: string;
+ fJsonFname: TCEFilename;
procedure setGenDoc(const aValue: boolean);
procedure setGenJSON(const aValue: boolean);
- procedure setDocDir(const aValue: string);
- procedure setJSONFile(const aValue: string);
+ procedure setDocDir(const aValue: TCEPathname);
+ procedure setJSONFile(const aValue: TCEFilename);
published
property generateDocumentation: boolean read fGenDoc write setGenDoc default false;
property generateJSON: boolean read fGenJson write setGenJSON default false;
- property DocumentationDirectory: string read fDocDir write setDocDir;
- property JSONFilename: string read fJsonFname write setJSONFile;
+ property DocumentationDirectory: TCEPathname read fDocDir write setDocDir;
+ property JSONFilename: TCEFilename read fJsonFname write setJSONFile;
public
procedure assign(aValue: TPersistent); override;
procedure getOpts(const aList: TStrings); override;
@@ -207,19 +207,22 @@ type
fExtraSrcs: TStringList;
fIncl: TStringList;
fImpt: TStringList;
- fFname: string;
- fObjDir: string;
- procedure setFname(const aValue: string);
- procedure setObjDir(const aValue: string);
- procedure setSrcs(const aValue: TStringList);
- procedure setIncl(const aValue: TStringList);
- procedure setImpt(const aValue: TStringList);
+ fExcl: TStringList;
+ fFname: TCEFilename;
+ fObjDir: TCEPathname;
+ procedure setFname(const aValue: TCEFilename);
+ procedure setObjDir(const aValue: TCEPathname);
+ procedure setSrcs(aValue: TStringList);
+ procedure setIncl(aValue: TStringList);
+ procedure setImpt(aValue: TStringList);
+ procedure setExcl(aValue: TStringList);
procedure strLstChange(sender: TObject);
published
- property outputFilename: string read fFname write setFname;
- property objectDirectory: string read fObjDir write setObjDir;
- property Sources: TStringList read fExtraSrcs write setSrcs stored false; deprecated;// will be reloaded but saved as extraSources
- property extraSources: TStringList read fExtraSrcs write setSrcs; // not common srcs, made for static libs
+ property outputFilename: TCEFilename read fFname write setFname;
+ property objectDirectory: TCEPathname read fObjDir write setObjDir;
+ property Sources: TStringList read fExtraSrcs write setSrcs stored false; deprecated;
+ property exclusions: TStringList read fExcl write setExcl;
+ property extraSources: TStringList read fExtraSrcs write setSrcs;
property includes: TStringList read fIncl write setIncl;
property imports: TStringList read fImpt write setImpt;
public
@@ -251,19 +254,19 @@ type
*)
TCustomProcOptions = class(TOptsGroup)
private
- fExecutable: string;
- fWorkDir: string;
+ fExecutable: TCEFilename;
+ fWorkDir: TCEPathname;
fOptions: TProcessOptions;
fParameters: TStringList;
fShowWin: TShowWindowOptions;
- procedure setExecutable(const aValue: string);
- procedure setWorkDir(const aValue: string);
+ procedure setExecutable(const aValue: TCEFilename);
+ procedure setWorkDir(const aValue: TCEPathname);
procedure setOptions(const aValue: TProcessOptions);
procedure setParameters(aValue: TStringList);
procedure setShowWin(const aValue: TShowWindowOptions);
protected
- property executable: string read fExecutable write setExecutable;
- property workingDirectory: string read fWorkDir write setWorkDir;
+ property executable: TCEFilename read fExecutable write setExecutable;
+ property workingDirectory: TCEPathname read fWorkDir write setWorkDir;
property options: TProcessOptions read fOptions write setOptions;
property parameters: TStringList read fParameters write setParameters;
property showWindow: TShowWindowOptions read fShowWin write setShowWin;
@@ -419,7 +422,7 @@ begin
doChanged;
end;
-procedure TDocOpts.setDocDir(const aValue: string);
+procedure TDocOpts.setDocDir(const aValue: TCEPathname);
begin
if fDocDir = aValue then
exit;
@@ -429,7 +432,7 @@ begin
doChanged;
end;
-procedure TDocOpts.setJSONFile(const aValue: string);
+procedure TDocOpts.setJSONFile(const aValue: TCEFilename);
begin
if fJsonFname = aValue then
exit;
@@ -824,11 +827,13 @@ begin
fExtraSrcs := TStringList.Create;
fIncl := TStringList.Create;
fImpt := TStringList.Create;
+ fExcl := TStringList.Create;
// setSrcs(), setIncl(), etc are not called when reloading from
// a stream but rather the TSgringList.Assign()
fExtraSrcs.OnChange := @strLstChange;
fIncl.OnChange := @strLstChange;
fImpt.OnChange := @strLstChange;
+ fExcl.OnChange := @strLstChange;
end;
procedure TPathsOpts.strLstChange(sender: TObject);
@@ -879,10 +884,11 @@ begin
fExtraSrcs.free;
fIncl.free;
fImpt.free;
+ fExcl.free;
inherited;
end;
-procedure TPathsOpts.setFname(const aValue: string);
+procedure TPathsOpts.setFname(const aValue: TCEFilename);
begin
if fFname = aValue then exit;
fFname := patchPlateformPath(aValue);
@@ -890,33 +896,40 @@ begin
doChanged;
end;
-procedure TPathsOpts.setObjDir(const aValue: string);
+procedure TPathsOpts.setObjDir(const aValue: TCEPathname);
begin
if fObjDir = aValue then exit;
fObjDir := patchPlateformPath(aValue);
doChanged;
end;
-procedure TPathsOpts.setSrcs(const aValue: TStringList);
+procedure TPathsOpts.setSrcs(aValue: TStringList);
begin
fExtraSrcs.Assign(aValue);
patchPlateformPaths(fExtraSrcs);
doChanged;
end;
-procedure TPathsOpts.setIncl(const aValue: TStringList);
+procedure TPathsOpts.setIncl(aValue: TStringList);
begin
fIncl.Assign(aValue);
patchPlateformPaths(fIncl);
doChanged;
end;
-procedure TPathsOpts.setImpt(const aValue: TStringList);
+procedure TPathsOpts.setImpt(aValue: TStringList);
begin
fImpt.Assign(aValue);
patchPlateformPaths(fImpt);
doChanged;
end;
+
+procedure TPathsOpts.setExcl(aValue: TStringList);
+begin
+ fExcl.Assign(aValue);
+ patchPlateformPaths(fExcl);
+ doChanged;
+end;
{$ENDREGION}
{$REGION TOtherOpts ------------------------------------------------------------}
@@ -1033,14 +1046,14 @@ begin
aProcess.StartupOptions := aProcess.StartupOptions + [suoUseShowWindow];
end;
-procedure TCustomProcOptions.setExecutable(const aValue: string);
+procedure TCustomProcOptions.setExecutable(const aValue: TCEFilename);
begin
if fExecutable = aValue then exit;
fExecutable := aValue;
doChanged;
end;
-procedure TCustomProcOptions.setWorkDir(const aValue: string);
+procedure TCustomProcOptions.setWorkDir(const aValue: TCEPathname);
begin
if fWorkDir = aValue then exit;
fWorkDir := aValue;
diff --git a/src/ce_dubwrap.pas b/src/ce_dubwrap.pas
new file mode 100644
index 00000000..109b8d48
--- /dev/null
+++ b/src/ce_dubwrap.pas
@@ -0,0 +1,181 @@
+unit ce_dubwrap;
+
+{$I ce_defines.inc}
+
+interface
+
+uses
+ Classes, SysUtils, ce_common, ce_writableComponent;
+
+type
+
+ TDubTargetType = ( autodetect, none, executable{, library}, sourceLibrary,
+ staticLibrary, dynamicLibrary);
+
+ TCEDubSubPackageItem = class(TCollectionItem)
+
+ end;
+
+ TCEDubSubPacakges = class(TCollection)
+
+ end;
+
+ TCEDubConfigurationItem = class(TCollectionItem)
+
+ end;
+
+ TCEDubConfigurations = class(TCollection)
+
+ end;
+
+ TCEDubBuildTypeItem = class(TCollectionItem)
+
+ end;
+
+ TCEDubBuildTypes = class(TCollection)
+
+ end;
+
+
+ (**
+ * Warps a DUB JSON project.
+ * JSON fields are converted to streamable/inspectable/published properties.
+ *
+ * the properties must produce the right JSON type when saved with TJSONStreamer.
+ *)
+ TCEDubProject = class(TWritableJsonComponent)
+ private
+ fUpdateCount: NativeInt;
+ //
+ fPackageName: string;
+ fDescription: string;
+ fHomepage: string;
+ fAuthors: string;
+ fCopyright: string;
+ fLicense: string;
+ //
+ //fDependencies: ["" : , "" : , ...] TCollection
+ fTargetType: TDubTargetType;
+ fSystemDependencies: string;
+ fTargetName: string;
+ fTargetPath: string;
+ fWorkingDirectory: string;
+ // fSubConfigurations: ["string" : "string", "string": string, ...] TCollection
+ fMainSourceFile: string;
+ fbuildRequirements: TStringList;
+ fbuildOptions: TStringList;
+ fLibs: TStringList;
+ fSourceFiles: TStringList;
+ fSourcePaths: TStringList;
+ fExcludedSourceFiles: TStringList;
+ fCopyFiles: TStringList;
+ fVersions: TStringList;
+ fDebugVersions: TStringList;
+ fImportPaths: TStringList;
+ fStringImportPaths: TStringList;
+ fPreGenerateCommands: TStringList;
+ fPostGenerateCommands: TStringList;
+ fPreBuildCommands: TStringList;
+ fPostBuildCommands: TStringList;
+ fDflags: TStringList;
+ fLflags: TStringList;
+ //
+ fSubPackages: TCEDubSubPacakges;
+ fConfigurations: TCEDubConfigurations;
+ fBuildTypes: TCEDubBuildTypes;
+ fDdoxFilterArgs: TStringList;
+ published
+
+ // global
+ property packageName: string read fPackageName;
+ property description: string read fDescription;
+ property homepage: string read fHomepage;
+ property authors: string read fAuthors;
+ property copyright: string read fCopyright;
+ property license: string read fLicense;
+
+ // common build settings
+ //dependencies;
+ property systemDependencies: string read fSystemDependencies;
+ property targetType: TDubTargetType read fTargetType;
+ property targetName: string read fTargetName;
+ property targetPath: string read fTargetPath;
+ property workingDirectory: string read fWorkingDirectory;
+ //subConfigurations;
+ property buildRequirements: TStringList read FbuildRequirements;
+ property buildOptions: TStringList read fBuildOptions;
+ property libs: TStringList read fLibs;
+ property sourceFiles: TStringList read fSourceFiles;
+ property sourcePaths: TStringList read fSourcePaths;
+ property excludedSourceFiles: TStringList read fExcludedSourceFiles;
+ property mainSourceFile: string read fMainSourceFile;
+ property copyFiles: TStringList read fCopyFiles;
+ property versions: TStringList read fVersions;
+ property debugVersions: TStringList read fDebugVersions;
+ property importPaths: TStringList read fImportPaths;
+ property stringImportPaths: TStringList read fStringImportPaths;
+ property preGenerateCommands: TStringList read fPreGenerateCommands;
+ property postGenerateCommands: TStringList read fPostGenerateCommands;
+ property preBuildCommands: TStringList read fPreBuildCommands;
+ property postBuildCommands: TStringList read fPostBuildCommands;
+ property dflags: TStringList read fDflags;
+ property lflags: TStringList read fLflags;
+
+ // collections
+ property subPackages: TCEDubSubPacakges read fSubPackages;
+ property configurations: TCEDubConfigurations read fConfigurations;
+ property buildTypes: TCEDubBuildTypes read fBuildTypes;
+ property ddoxFilterArgs: TStringList read fDdoxFilterArgs;
+ public
+ constructor create(aOwner: TComponent); override;
+ destructor destroy; override;
+ //
+ procedure Update;
+ procedure beginUpdate;
+ procedure endUpdate;
+ //
+ procedure getSourcesList(aList: TStringList);
+
+ end;
+
+implementation
+
+
+constructor TCEDubProject.create(aOwner: TComponent);
+begin
+ inherited;
+end;
+
+destructor TCEDubProject.destroy;
+begin
+ inherited;
+end;
+
+procedure TCEDubProject.beginUpdate;
+begin
+ fUpdateCount += 1;
+end;
+
+procedure TCEDubProject.endUpdate;
+begin
+ fUpdateCount -= 1;
+ if fUpdateCount <= 0 then
+ Update;
+end;
+
+procedure TCEDubProject.Update;
+begin
+ fUpdateCount := 0;
+end;
+
+procedure TCEDubProject.getSourcesList(aList: TStringList);
+begin
+ {
+ sourceFiles - excluded
+ sourcePath - excluded
+ auto detection - excluded
+ }
+end;
+
+end.
+
diff --git a/src/ce_inspectors.pas b/src/ce_inspectors.pas
new file mode 100644
index 00000000..6ccd14be
--- /dev/null
+++ b/src/ce_inspectors.pas
@@ -0,0 +1,76 @@
+unit ce_inspectors;
+
+{$I ce_defines.inc}
+
+interface
+
+uses
+ Classes, SysUtils, Dialogs, PropEdits;
+
+type
+
+ TCEPathname = type string;
+ TCEFilename = type string;
+
+ TCustomPathType = (ptFile, ptFolder);
+
+ TCECustomPathEditor = class(TStringPropertyEditor)
+ private
+ fType: TCustomPathType;
+ public
+ function GetAttributes: TPropertyAttributes; override;
+ procedure Edit; override;
+ end;
+
+ TCEPathnameEditor = class(TCECustomPathEditor)
+ constructor Create(Hook: TPropertyEditorHook; APropCount: Integer); override;
+ end;
+
+ TCEFilenameEditor = class(TCECustomPathEditor)
+ constructor Create(Hook: TPropertyEditorHook; APropCount: Integer); override;
+ end;
+
+
+implementation
+
+function TCECustomPathEditor.GetAttributes: TPropertyAttributes;
+begin
+ exit( inherited GetAttributes() + [paDialog]);
+end;
+
+procedure TCECustomPathEditor.Edit;
+var
+ newValue: string;
+begin
+ case fType of
+ ptFile:
+ with TOpenDialog.create(nil) do try
+ InitialDir := ExtractFileName(GetValue);
+ FileName := GetValue;
+ if Execute then SetValue(FileName);
+ finally
+ free;
+ end;
+ ptFolder:
+ if SelectDirectory(GetPropInfo^.Name, GetValue, newValue) then
+ SetValue(newValue);
+ end;
+end;
+
+constructor TCEPathnameEditor.Create(Hook: TPropertyEditorHook; APropCount: Integer);
+begin
+ inherited;
+ fType := ptFolder;
+end;
+
+constructor TCEFilenameEditor.Create(Hook: TPropertyEditorHook; APropCount: Integer);
+begin
+ inherited;
+ fType := ptFile;
+end;
+
+initialization
+ RegisterPropertyEditor(TypeInfo(TCEPathname), nil, '', TCEPathnameEditor);
+ RegisterPropertyEditor(TypeInfo(TCEFilename), nil, '', TCEfilenameEditor);
+end.
+
diff --git a/src/ce_libman.pas b/src/ce_libman.pas
index 7dd06813..80c8c52c 100644
--- a/src/ce_libman.pas
+++ b/src/ce_libman.pas
@@ -27,7 +27,7 @@ type
(**
* Represents all the D libraries present on this system.
*)
- TLibraryManager = class(TWritableComponent)
+ TLibraryManager = class(TWritableLfmTextComponent)
private
fCol: TCollection;
procedure setCol(const aValue: TCollection);
diff --git a/src/ce_messages.pas b/src/ce_messages.pas
index 2df813a3..b7992353 100644
--- a/src/ce_messages.pas
+++ b/src/ce_messages.pas
@@ -416,6 +416,8 @@ begin
dt := new(PMessageData);
dt^.data := aData;
dt^.ctxt := aCtxt;
+ if fAutoSelect then if fCtxt <> aCtxt then
+ fBtns[aCtxt].Click;
item := List.Items.Add(nil, aValue);
item.Data := dt;
item.ImageIndex := iconIndex(aKind);
@@ -423,8 +425,6 @@ begin
clearOutOfRangeMessg;
scrollToBack;
Application.ProcessMessages;
- if fAutoSelect then if fCtxt <> aCtxt then
- fBtns[aCtxt].Click;
filterMessages(fCtxt);
end;
diff --git a/src/ce_options.pas b/src/ce_options.pas
index a7b1cc1f..3175a218 100644
--- a/src/ce_options.pas
+++ b/src/ce_options.pas
@@ -9,7 +9,7 @@ uses
type
- TCEOptions = class(TWritableComponent)
+ TCEOptions = class(TWritableLfmTextComponent)
private
fSubjPersObservers: TCECustomSubject;
protected
diff --git a/src/ce_project.pas b/src/ce_project.pas
index 80cde6a4..2937f136 100644
--- a/src/ce_project.pas
+++ b/src/ce_project.pas
@@ -21,7 +21,7 @@ type
*
* Basically it' s designed to provide the options for the dmd process.
*)
- TCEProject = class(TWritableComponent)
+ TCEProject = class(TWritableLfmTextComponent)
private
fOnChange: TNotifyEvent;
fModified: boolean;
@@ -319,18 +319,46 @@ end;
procedure TCEProject.getOpts(const aList: TStrings);
var
rel, abs: string;
+ i: Integer;
+ ex_files: TStringList;
+ ex_folds: TStringList;
+ str: string;
begin
if fConfIx = -1 then exit;
- for rel in fSrcs do if rel <> '' then
- begin
- abs := expandFilenameEx(fBasePath,rel);
- aList.Add(abs); // process.inc ln 249. double quotes are added if there's a space.
+ ex_files := TStringList.Create;
+ ex_folds := TStringList.Create;
+ try
+ // prepares the exclusions
+ for i := 0 to currentConfiguration.pathsOptions.exclusions.Count-1 do
+ begin
+ str := symbolExpander.get(currentConfiguration.pathsOptions.exclusions.Strings[i]);
+ rel := expandFilenameEx(fBasePath, currentConfiguration.pathsOptions.exclusions.Strings[i]);
+ if fileExists(str) then
+ ex_files.Add(str)
+ else if DirectoryExists(str) then
+ ex_folds.Add(str);
+ if fileExists(rel) then
+ ex_files.Add(rel)
+ else if DirectoryExists(rel) then
+ ex_folds.Add(rel);
+ end;
+ // sources
+ for rel in fSrcs do if rel <> '' then
+ begin
+ abs := expandFilenameEx(fBasePath, rel);
+ if ex_files.IndexOf(abs) = -1 then
+ if ex_folds.IndexOf(ExtractFilePath(abs)) = -1
+ then aList.Add(abs); // note: process.inc ln 249. double quotes are added if there's a space.
+ end;
+ // libraries
+ LibMan.getLibFiles(fLibAliases, aList);
+ LibMan.getLibSources(fLibAliases, aList);
+ // config
+ TCompilerConfiguration(fOptsColl.Items[fConfIx]).getOpts(aList);
+ finally
+ ex_files.Free;
+ ex_folds.Free;
end;
- //
- LibMan.getLibFiles(fLibAliases, aList);
- LibMan.getLibSources(fLibAliases, aList);
- //
- TCompilerConfiguration(fOptsColl.Items[fConfIx]).getOpts(aList);
end;
function TCEProject.isProjectSource(const aFilename: string): boolean;
@@ -449,7 +477,6 @@ var
//
begin
patchPlateformPaths(fSrcs);
- doChanged;
fModified := false;
hasPatched := false;
//
@@ -463,9 +490,9 @@ begin
'paths or file may still exist (-of, -od, extraSources, etc)' +
'but cannot be automatically handled. Note that the modifications have not been saved.');
end;
- endUpdate;
//
updateOutFilename;
+ endUpdate;
if not hasPatched then fModified := false;
end;
diff --git a/src/ce_staticmacro.pas b/src/ce_staticmacro.pas
index 357747af..d2513d3a 100644
--- a/src/ce_staticmacro.pas
+++ b/src/ce_staticmacro.pas
@@ -22,7 +22,7 @@ type
* Shift + SPACE works automatically on the right editor (ICEMultiDocObserver)
* Automatic insertion is handled in TCESynMemo.KeyUp()
*)
- TCEStaticEditorMacro = class(TWritableComponent, ICEMultiDocObserver)
+ TCEStaticEditorMacro = class(TWritableLfmTextComponent, ICEMultiDocObserver)
private
fCompletor: TSynAutoComplete;
fMacros: TStringList;
diff --git a/src/ce_synmemo.pas b/src/ce_synmemo.pas
index 4d03bfa4..41999a36 100644
--- a/src/ce_synmemo.pas
+++ b/src/ce_synmemo.pas
@@ -24,7 +24,7 @@ type
property nestedIndex: Integer read fNestedIndex write fNestedIndex;
end;
- TCESynMemoCache = class(TWritableComponent)
+ TCESynMemoCache = class(TWritableLfmTextComponent)
private
fMemo: TCESynMemo;
fFolds: TCollection;
diff --git a/src/ce_tools.pas b/src/ce_tools.pas
index bf5254db..1ade2103 100644
--- a/src/ce_tools.pas
+++ b/src/ce_tools.pas
@@ -6,15 +6,15 @@ interface
uses
Classes, SysUtils, FileUtil, process, menus,
- ce_common, ce_writableComponent, ce_interfaces, ce_observer;
+ ce_common, ce_writableComponent, ce_interfaces, ce_observer, ce_inspectors;
type
TCEToolItem = class(TCollectionItem)
private
fProcess: TCheckedAsyncProcess;
- fExecutable: string;
- fWorkingDir: string;
+ fExecutable: TCEFilename;
+ fWorkingDir: TCEPathname;
fShowWin: TShowWindowOptions;
fOpts: TProcessOptions;
fParameters: TStringList;
@@ -32,8 +32,8 @@ type
published
property toolAlias: string read fToolAlias write fToolAlias;
property options: TProcessOptions read fOpts write fOpts;
- property executable: string read fExecutable write fExecutable;
- property workingDirectory: string read fWorkingDir write fWorkingDir;
+ property executable: TCEFilename read fExecutable write fExecutable;
+ property workingDirectory: TCEPathname read fWorkingDir write fWorkingDir;
property parameters: TStringList read fParameters write setParameters;
property showWindows: TShowWindowOptions read fShowWin write fShowWin;
property queryParameters: boolean read fQueryParams write fQueryParams;
@@ -45,7 +45,7 @@ type
destructor destroy; override;
end;
- TCETools = class(TWritableComponent, ICEMainMenuProvider)
+ TCETools = class(TWritableLfmTextComponent, ICEMainMenuProvider)
private
fTools: TCollection;
function getTool(index: Integer): TCEToolItem;
diff --git a/src/ce_writablecomponent.pas b/src/ce_writablecomponent.pas
index 046fa49c..1804c17b 100644
--- a/src/ce_writablecomponent.pas
+++ b/src/ce_writablecomponent.pas
@@ -5,17 +5,20 @@ unit ce_writableComponent;
interface
uses
- Classes, SysUtils, ce_common;
+ Classes, SysUtils, ce_common, typinfo, fpjson, jsonparser, fpjsonrtti, fpjsondataset;
type
(**
- * The ancestor of classes which can be saved or reloaded to/from
- * a text file. It's used each time some options or data have to
+ * The ancestor of classes which can be saved or reloaded to/from a file.
+ * It's used each time some options or data have to
* persist from a cession to another, independently from the centralized
* system provided by the ICESessionOptionObserver/Subject mechanism.
+ *
+ * The descendants overrides customLoadFromFile and customSaveToFile
+ * to save/load to/from a specific format.
*)
- TWritableComponent = class(TComponent)
+ TCustomWritableComponent = class(TComponent)
protected
fFilename: string;
fHasLoaded: boolean;
@@ -25,10 +28,8 @@ type
procedure beforeSave; virtual;
procedure afterLoad; virtual;
procedure afterSave; virtual;
- procedure readerPropNoFound(Reader: TReader; Instance: TPersistent;
- var PropName: string; IsPath: boolean; var Handled, Skip: Boolean); virtual;
- procedure readerError(Reader: TReader; const Message: string;
- var Handled: Boolean); virtual;
+ procedure customLoadFromFile(const aFilename: string); virtual; abstract;
+ procedure customSaveToFile(const aFilename: string); virtual; abstract;
public
procedure saveToFile(const aFilename: string); virtual;
procedure loadFromFile(const aFilename: string); virtual;
@@ -38,49 +39,66 @@ type
property hasSaved: boolean read fHasSaved;
end;
+ (**
+ * The ancestor of classes which can be saved or reloaded to/from
+ * a LFM text file.
+ * By default, reading errors are skipped and no exception is raised.
+ *)
+ TWritableLfmTextComponent = class(TCustomWritableComponent)
+ protected
+ procedure customLoadFromFile(const aFilename: string); override;
+ procedure customSaveToFile(const aFilename: string); override;
+ procedure readerPropNoFound(Reader: TReader; Instance: TPersistent;
+ var PropName: string; IsPath: boolean; var Handled, Skip: Boolean); virtual;
+ procedure readerError(Reader: TReader; const Message: string;
+ var Handled: Boolean); virtual;
+ end;
+
+ (**
+ * The ancestor of classes which can be saved or reloaded to/from
+ * a JSON file.
+ * By default, reading errors are skipped and no exception is raised.
+ *)
+ TWritableJsonComponent = class(TCustomWritableComponent)
+ protected
+ procedure propertyError(Sender : TObject; AObject : TObject; Info : PPropInfo;
+ AValue : TJSONData; Error : Exception; Var doContinue : Boolean); virtual;
+ procedure restoreProperty(Sender : TObject; AObject : TObject; Info : PPropInfo;
+ AValue : TJSONData; Var Handled : Boolean); virtual;
+ procedure customLoadFromFile(const aFilename: string); override;
+ procedure customSaveToFile(const aFilename: string); override;
+ end;
+
implementation
-procedure TWritableComponent.beforeSave;
+{$REGION TCustomWritableComponent ----------------------------------------------}
+procedure TCustomWritableComponent.beforeSave;
begin
end;
-procedure TWritableComponent.beforeLoad;
+procedure TCustomWritableComponent.beforeLoad;
begin
end;
-procedure TWritableComponent.afterLoad;
+procedure TCustomWritableComponent.afterLoad;
begin
end;
-procedure TWritableComponent.afterSave;
+procedure TCustomWritableComponent.afterSave;
begin
end;
-procedure TWritableComponent.setFilename(const aValue: string);
+procedure TCustomWritableComponent.setFilename(const aValue: string);
begin
fFilename := aValue;
end;
-procedure TWritableComponent.readerPropNoFound(Reader: TReader; Instance: TPersistent;
- var PropName: string; IsPath: boolean; var Handled, Skip: Boolean);
-begin
- Handled := true;
- Skip := true;
-end;
-
-procedure TWritableComponent.readerError(Reader: TReader; const Message: string;
- var Handled: Boolean);
-begin
- Handled := true;
- fHasLoaded := false;
-end;
-
-procedure TWritableComponent.saveToFile(const aFilename: string);
+procedure TCustomWritableComponent.saveToFile(const aFilename: string);
begin
fHasSaved := true;
beforeSave;
try
- saveCompToTxtFile(self, aFilename);
+ customSaveToFile(aFilename);
except
fHasSaved := false;
end;
@@ -88,15 +106,95 @@ begin
afterSave;
end;
-procedure TWritableComponent.loadFromFile(const aFilename: string);
+procedure TCustomWritableComponent.loadFromFile(const aFilename: string);
begin
fHasLoaded := true;
beforeLoad;
setFilename(aFilename);
- loadCompFromTxtFile(self, aFilename, @readerPropNoFound, @readerError);
+ customLoadFromFile(aFilename);
afterLoad;
end;
+{$ENDREGION}
+
+{$REGION TWritableLfmTextComponent ---------------------------------------------}
+procedure TWritableLfmTextComponent.customSaveToFile(const aFilename: string);
+begin
+ saveCompToTxtFile(self, aFilename);
+end;
+
+procedure TWritableLfmTextComponent.customLoadFromFile(const aFilename: string);
+begin
+ loadCompFromTxtFile(self, aFilename, @readerPropNoFound, @readerError);
+end;
+
+procedure TWritableLfmTextComponent.readerPropNoFound(Reader: TReader; Instance: TPersistent;
+ var PropName: string; IsPath: boolean; var Handled, Skip: Boolean);
+begin
+ Handled := true;
+ Skip := true;
+end;
+
+procedure TWritableLfmTextComponent.readerError(Reader: TReader; const Message: string;
+ var Handled: Boolean);
+begin
+ Handled := true;
+ fHasLoaded := false;
+end;
+{$ENDREGION}
+
+{$REGION TWritableJsonComponent ------------------------------------------------}
+procedure TWritableJsonComponent.propertyError(Sender : TObject; AObject : TObject; Info : PPropInfo;
+ AValue : TJSONData; Error : Exception; Var doContinue : Boolean);
+begin
+ doContinue := true;
+end;
+
+procedure TWritableJsonComponent.restoreProperty(Sender : TObject; AObject : TObject; Info : PPropInfo;
+ AValue : TJSONData; Var Handled : Boolean);
+begin
+ Handled := true;
+end;
+
+procedure TWritableJsonComponent.customSaveToFile(const aFilename: string);
+var
+ file_str: TMemoryStream;
+ json_str: TJSONStreamer;
+ json_dat: TJSONStringType;
+begin
+ file_str := TMemoryStream.Create;
+ json_str := TJSONStreamer.Create(nil);
+ try
+ json_dat := json_str.ObjectToJSONString(self);
+ file_str.Write(json_dat[1], length(json_dat));
+ file_str.SaveToFile(aFilename);
+ finally
+ file_str.Free;
+ json_str.Free;
+ end;
+end;
+
+procedure TWritableJsonComponent.customLoadFromFile(const aFilename: string);
+var
+ file_str: TMemoryStream;
+ json_str: TJSONDeStreamer;
+ json_dat: TJSONStringType;
+begin
+ file_str := TMemoryStream.Create;
+ json_str := TJSONDeStreamer.Create(nil);
+ try
+ json_str.OnPropertyError:= @propertyError;
+ json_str.OnRestoreProperty := @restoreProperty;
+ file_str.LoadFromFile(aFilename);
+ setLength(json_dat, file_str.Size);
+ file_str.Read(json_dat[1], length(json_dat));
+ json_str.JSONToObject(json_dat, self);
+ finally
+ file_str.Free;
+ json_str.Free;
+ end;
+end;
+{$ENDREGION}
initialization
- registerClasses([TWritableComponent]);
+ registerClasses([TCustomWritableComponent, TWritableLfmTextComponent, TWritableJsonComponent]);
end.