Merge branch 'a11_2_a12'

This commit is contained in:
Basile Burg 2015-01-25 23:17:35 +01:00
commit 325f9c01ca
16 changed files with 507 additions and 103 deletions

View File

@ -3,8 +3,7 @@ Coedit
Coedit is a simple IDE for the [D2](http://dlang.org) lang. (**Co** mpile & **Edit**). Coedit is a simple IDE for the [D2](http://dlang.org) lang. (**Co** mpile & **Edit**).
![](lazproj/coedit.win7.33.png) ![](lazproj/coedit.win7.33.png) ![](lazproj/coedit.linux.kde.33.png)
![](lazproj/coedit.linux.kde.33.png)
Current features Current features
---------------- ----------------
@ -17,7 +16,7 @@ Current features
- module symbol list. - module symbol list.
- static libraries manager. - static libraries manager.
- search and replace. - search and replace.
- "todo comment" analyzer. - "todo comments" analyzer.
- user-defined tools powered by a string interpolation system. - 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. - [D Completion Daemon](https://github.com/Hackerpilot/DCD) integration for completion proposal and source code hints.
- mini file browser. - mini file browser.
@ -31,7 +30,7 @@ Project information
- status: alpha 11. - status: alpha 11.
- license: MIT. - license: MIT.
- programmed in Object Pascal with [Lazarus & FPC](http://www.lazarus.freepascal.org) as IDE & compiler. - 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 Setup & test
------------ ------------

View File

@ -77,13 +77,13 @@ private struct TodoItem
if (prior.length) try auto i = to!long(prior); if (prior.length) try auto i = to!long(prior);
catch(Exception e) prior = ""; catch(Exception e) prior = "";
fFields[TodoField.filename] = fname; fFields[TodoField.filename] = fname.idup;
fFields[TodoField.line] = line; fFields[TodoField.line] = line.idup;
fFields[TodoField.text] = text; fFields[TodoField.text] = text.idup;
fFields[TodoField.category] = cat; fFields[TodoField.category] = cat.idup;
fFields[TodoField.assignee] = ass; fFields[TodoField.assignee] = ass.idup;
fFields[TodoField.priority] = prior; fFields[TodoField.priority] = prior.idup;
fFields[TodoField.status] = status; fFields[TodoField.status] = status.idup;
} }
/** /**

View File

@ -140,7 +140,7 @@
<PackageName Value="LCL"/> <PackageName Value="LCL"/>
</Item6> </Item6>
</RequiredPackages> </RequiredPackages>
<Units Count="34"> <Units Count="36">
<Unit0> <Unit0>
<Filename Value="coedit.lpr"/> <Filename Value="coedit.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -353,6 +353,16 @@
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="ce_todolist"/> <UnitName Value="ce_todolist"/>
</Unit33> </Unit33>
<Unit34>
<Filename Value="..\src\ce_dubwrap.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ce_dubwrap"/>
</Unit34>
<Unit35>
<Filename Value="..\src\ce_inspectors.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ce_inspectors"/>
</Unit35>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

View File

@ -8,7 +8,7 @@ uses
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, ce_observer, ce_libman, Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, ce_observer, ce_libman,
ce_tools, ce_dcd, ce_main, ce_writableComponent, ce_options, ce_symstring, 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} {$R *.res}

View File

@ -16,7 +16,7 @@ type
* Completion, hints and declaration finder automatically work on the current * Completion, hints and declaration finder automatically work on the current
* document: ICEMultiDocObserver. * document: ICEMultiDocObserver.
*) *)
TCEDcdWrapper = class(TWritableComponent, ICEProjectObserver, ICEMultiDocObserver) TCEDcdWrapper = class(TWritableLfmTextComponent, ICEProjectObserver, ICEMultiDocObserver)
private private
fTempLines: TStringList; fTempLines: TStringList;
//fPortNum: Word; //fPortNum: Word;

View File

@ -5,7 +5,7 @@ unit ce_dmdwrap;
interface interface
uses uses
classes, sysutils, process, asyncprocess, ce_common; classes, sysutils, process, asyncprocess, ce_common, ce_inspectors;
(* (*
@ -39,18 +39,18 @@ type
TDocOpts = class(TOptsGroup) TDocOpts = class(TOptsGroup)
private private
fGenDoc: boolean; fGenDoc: boolean;
fDocDir: string; fDocDir: TCEPathname;
fGenJson: boolean; fGenJson: boolean;
fJsonFname: string; fJsonFname: TCEFilename;
procedure setGenDoc(const aValue: boolean); procedure setGenDoc(const aValue: boolean);
procedure setGenJSON(const aValue: boolean); procedure setGenJSON(const aValue: boolean);
procedure setDocDir(const aValue: string); procedure setDocDir(const aValue: TCEPathname);
procedure setJSONFile(const aValue: string); procedure setJSONFile(const aValue: TCEFilename);
published published
property generateDocumentation: boolean read fGenDoc write setGenDoc default false; property generateDocumentation: boolean read fGenDoc write setGenDoc default false;
property generateJSON: boolean read fGenJson write setGenJSON default false; property generateJSON: boolean read fGenJson write setGenJSON default false;
property DocumentationDirectory: string read fDocDir write setDocDir; property DocumentationDirectory: TCEPathname read fDocDir write setDocDir;
property JSONFilename: string read fJsonFname write setJSONFile; property JSONFilename: TCEFilename read fJsonFname write setJSONFile;
public public
procedure assign(aValue: TPersistent); override; procedure assign(aValue: TPersistent); override;
procedure getOpts(const aList: TStrings); override; procedure getOpts(const aList: TStrings); override;
@ -207,19 +207,22 @@ type
fExtraSrcs: TStringList; fExtraSrcs: TStringList;
fIncl: TStringList; fIncl: TStringList;
fImpt: TStringList; fImpt: TStringList;
fFname: string; fExcl: TStringList;
fObjDir: string; fFname: TCEFilename;
procedure setFname(const aValue: string); fObjDir: TCEPathname;
procedure setObjDir(const aValue: string); procedure setFname(const aValue: TCEFilename);
procedure setSrcs(const aValue: TStringList); procedure setObjDir(const aValue: TCEPathname);
procedure setIncl(const aValue: TStringList); procedure setSrcs(aValue: TStringList);
procedure setImpt(const aValue: TStringList); procedure setIncl(aValue: TStringList);
procedure setImpt(aValue: TStringList);
procedure setExcl(aValue: TStringList);
procedure strLstChange(sender: TObject); procedure strLstChange(sender: TObject);
published published
property outputFilename: string read fFname write setFname; property outputFilename: TCEFilename read fFname write setFname;
property objectDirectory: string read fObjDir write setObjDir; property objectDirectory: TCEPathname read fObjDir write setObjDir;
property Sources: TStringList read fExtraSrcs write setSrcs stored false; deprecated;// will be reloaded but saved as extraSources property Sources: TStringList read fExtraSrcs write setSrcs stored false; deprecated;
property extraSources: TStringList read fExtraSrcs write setSrcs; // not common srcs, made for static libs property exclusions: TStringList read fExcl write setExcl;
property extraSources: TStringList read fExtraSrcs write setSrcs;
property includes: TStringList read fIncl write setIncl; property includes: TStringList read fIncl write setIncl;
property imports: TStringList read fImpt write setImpt; property imports: TStringList read fImpt write setImpt;
public public
@ -251,19 +254,19 @@ type
*) *)
TCustomProcOptions = class(TOptsGroup) TCustomProcOptions = class(TOptsGroup)
private private
fExecutable: string; fExecutable: TCEFilename;
fWorkDir: string; fWorkDir: TCEPathname;
fOptions: TProcessOptions; fOptions: TProcessOptions;
fParameters: TStringList; fParameters: TStringList;
fShowWin: TShowWindowOptions; fShowWin: TShowWindowOptions;
procedure setExecutable(const aValue: string); procedure setExecutable(const aValue: TCEFilename);
procedure setWorkDir(const aValue: string); procedure setWorkDir(const aValue: TCEPathname);
procedure setOptions(const aValue: TProcessOptions); procedure setOptions(const aValue: TProcessOptions);
procedure setParameters(aValue: TStringList); procedure setParameters(aValue: TStringList);
procedure setShowWin(const aValue: TShowWindowOptions); procedure setShowWin(const aValue: TShowWindowOptions);
protected protected
property executable: string read fExecutable write setExecutable; property executable: TCEFilename read fExecutable write setExecutable;
property workingDirectory: string read fWorkDir write setWorkDir; property workingDirectory: TCEPathname read fWorkDir write setWorkDir;
property options: TProcessOptions read fOptions write setOptions; property options: TProcessOptions read fOptions write setOptions;
property parameters: TStringList read fParameters write setParameters; property parameters: TStringList read fParameters write setParameters;
property showWindow: TShowWindowOptions read fShowWin write setShowWin; property showWindow: TShowWindowOptions read fShowWin write setShowWin;
@ -419,7 +422,7 @@ begin
doChanged; doChanged;
end; end;
procedure TDocOpts.setDocDir(const aValue: string); procedure TDocOpts.setDocDir(const aValue: TCEPathname);
begin begin
if fDocDir = aValue then if fDocDir = aValue then
exit; exit;
@ -429,7 +432,7 @@ begin
doChanged; doChanged;
end; end;
procedure TDocOpts.setJSONFile(const aValue: string); procedure TDocOpts.setJSONFile(const aValue: TCEFilename);
begin begin
if fJsonFname = aValue then if fJsonFname = aValue then
exit; exit;
@ -824,11 +827,13 @@ begin
fExtraSrcs := TStringList.Create; fExtraSrcs := TStringList.Create;
fIncl := TStringList.Create; fIncl := TStringList.Create;
fImpt := TStringList.Create; fImpt := TStringList.Create;
fExcl := TStringList.Create;
// setSrcs(), setIncl(), etc are not called when reloading from // setSrcs(), setIncl(), etc are not called when reloading from
// a stream but rather the TSgringList.Assign() // a stream but rather the TSgringList.Assign()
fExtraSrcs.OnChange := @strLstChange; fExtraSrcs.OnChange := @strLstChange;
fIncl.OnChange := @strLstChange; fIncl.OnChange := @strLstChange;
fImpt.OnChange := @strLstChange; fImpt.OnChange := @strLstChange;
fExcl.OnChange := @strLstChange;
end; end;
procedure TPathsOpts.strLstChange(sender: TObject); procedure TPathsOpts.strLstChange(sender: TObject);
@ -879,10 +884,11 @@ begin
fExtraSrcs.free; fExtraSrcs.free;
fIncl.free; fIncl.free;
fImpt.free; fImpt.free;
fExcl.free;
inherited; inherited;
end; end;
procedure TPathsOpts.setFname(const aValue: string); procedure TPathsOpts.setFname(const aValue: TCEFilename);
begin begin
if fFname = aValue then exit; if fFname = aValue then exit;
fFname := patchPlateformPath(aValue); fFname := patchPlateformPath(aValue);
@ -890,33 +896,40 @@ begin
doChanged; doChanged;
end; end;
procedure TPathsOpts.setObjDir(const aValue: string); procedure TPathsOpts.setObjDir(const aValue: TCEPathname);
begin begin
if fObjDir = aValue then exit; if fObjDir = aValue then exit;
fObjDir := patchPlateformPath(aValue); fObjDir := patchPlateformPath(aValue);
doChanged; doChanged;
end; end;
procedure TPathsOpts.setSrcs(const aValue: TStringList); procedure TPathsOpts.setSrcs(aValue: TStringList);
begin begin
fExtraSrcs.Assign(aValue); fExtraSrcs.Assign(aValue);
patchPlateformPaths(fExtraSrcs); patchPlateformPaths(fExtraSrcs);
doChanged; doChanged;
end; end;
procedure TPathsOpts.setIncl(const aValue: TStringList); procedure TPathsOpts.setIncl(aValue: TStringList);
begin begin
fIncl.Assign(aValue); fIncl.Assign(aValue);
patchPlateformPaths(fIncl); patchPlateformPaths(fIncl);
doChanged; doChanged;
end; end;
procedure TPathsOpts.setImpt(const aValue: TStringList); procedure TPathsOpts.setImpt(aValue: TStringList);
begin begin
fImpt.Assign(aValue); fImpt.Assign(aValue);
patchPlateformPaths(fImpt); patchPlateformPaths(fImpt);
doChanged; doChanged;
end; end;
procedure TPathsOpts.setExcl(aValue: TStringList);
begin
fExcl.Assign(aValue);
patchPlateformPaths(fExcl);
doChanged;
end;
{$ENDREGION} {$ENDREGION}
{$REGION TOtherOpts ------------------------------------------------------------} {$REGION TOtherOpts ------------------------------------------------------------}
@ -1033,14 +1046,14 @@ begin
aProcess.StartupOptions := aProcess.StartupOptions + [suoUseShowWindow]; aProcess.StartupOptions := aProcess.StartupOptions + [suoUseShowWindow];
end; end;
procedure TCustomProcOptions.setExecutable(const aValue: string); procedure TCustomProcOptions.setExecutable(const aValue: TCEFilename);
begin begin
if fExecutable = aValue then exit; if fExecutable = aValue then exit;
fExecutable := aValue; fExecutable := aValue;
doChanged; doChanged;
end; end;
procedure TCustomProcOptions.setWorkDir(const aValue: string); procedure TCustomProcOptions.setWorkDir(const aValue: TCEPathname);
begin begin
if fWorkDir = aValue then exit; if fWorkDir = aValue then exit;
fWorkDir := aValue; fWorkDir := aValue;

181
src/ce_dubwrap.pas Normal file
View File

@ -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: ["<name>" : <version-spec>, "<name>" : <version-spec>, ...] 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.

76
src/ce_inspectors.pas Normal file
View File

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

View File

@ -27,7 +27,7 @@ type
(** (**
* Represents all the D libraries present on this system. * Represents all the D libraries present on this system.
*) *)
TLibraryManager = class(TWritableComponent) TLibraryManager = class(TWritableLfmTextComponent)
private private
fCol: TCollection; fCol: TCollection;
procedure setCol(const aValue: TCollection); procedure setCol(const aValue: TCollection);

View File

@ -416,6 +416,8 @@ begin
dt := new(PMessageData); dt := new(PMessageData);
dt^.data := aData; dt^.data := aData;
dt^.ctxt := aCtxt; dt^.ctxt := aCtxt;
if fAutoSelect then if fCtxt <> aCtxt then
fBtns[aCtxt].Click;
item := List.Items.Add(nil, aValue); item := List.Items.Add(nil, aValue);
item.Data := dt; item.Data := dt;
item.ImageIndex := iconIndex(aKind); item.ImageIndex := iconIndex(aKind);
@ -423,8 +425,6 @@ begin
clearOutOfRangeMessg; clearOutOfRangeMessg;
scrollToBack; scrollToBack;
Application.ProcessMessages; Application.ProcessMessages;
if fAutoSelect then if fCtxt <> aCtxt then
fBtns[aCtxt].Click;
filterMessages(fCtxt); filterMessages(fCtxt);
end; end;

View File

@ -9,7 +9,7 @@ uses
type type
TCEOptions = class(TWritableComponent) TCEOptions = class(TWritableLfmTextComponent)
private private
fSubjPersObservers: TCECustomSubject; fSubjPersObservers: TCECustomSubject;
protected protected

View File

@ -21,7 +21,7 @@ type
* *
* Basically it' s designed to provide the options for the dmd process. * Basically it' s designed to provide the options for the dmd process.
*) *)
TCEProject = class(TWritableComponent) TCEProject = class(TWritableLfmTextComponent)
private private
fOnChange: TNotifyEvent; fOnChange: TNotifyEvent;
fModified: boolean; fModified: boolean;
@ -319,18 +319,46 @@ end;
procedure TCEProject.getOpts(const aList: TStrings); procedure TCEProject.getOpts(const aList: TStrings);
var var
rel, abs: string; rel, abs: string;
i: Integer;
ex_files: TStringList;
ex_folds: TStringList;
str: string;
begin begin
if fConfIx = -1 then exit; if fConfIx = -1 then exit;
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 for rel in fSrcs do if rel <> '' then
begin begin
abs := expandFilenameEx(fBasePath, rel); abs := expandFilenameEx(fBasePath, rel);
aList.Add(abs); // process.inc ln 249. double quotes are added if there's a space. 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; end;
// // libraries
LibMan.getLibFiles(fLibAliases, aList); LibMan.getLibFiles(fLibAliases, aList);
LibMan.getLibSources(fLibAliases, aList); LibMan.getLibSources(fLibAliases, aList);
// // config
TCompilerConfiguration(fOptsColl.Items[fConfIx]).getOpts(aList); TCompilerConfiguration(fOptsColl.Items[fConfIx]).getOpts(aList);
finally
ex_files.Free;
ex_folds.Free;
end;
end; end;
function TCEProject.isProjectSource(const aFilename: string): boolean; function TCEProject.isProjectSource(const aFilename: string): boolean;
@ -449,7 +477,6 @@ var
// //
begin begin
patchPlateformPaths(fSrcs); patchPlateformPaths(fSrcs);
doChanged;
fModified := false; fModified := false;
hasPatched := false; hasPatched := false;
// //
@ -463,9 +490,9 @@ begin
'paths or file may still exist (-of, -od, extraSources, etc)' + 'paths or file may still exist (-of, -od, extraSources, etc)' +
'but cannot be automatically handled. Note that the modifications have not been saved.'); 'but cannot be automatically handled. Note that the modifications have not been saved.');
end; end;
endUpdate;
// //
updateOutFilename; updateOutFilename;
endUpdate;
if not hasPatched then fModified := false; if not hasPatched then fModified := false;
end; end;

View File

@ -22,7 +22,7 @@ type
* Shift + SPACE works automatically on the right editor (ICEMultiDocObserver) * Shift + SPACE works automatically on the right editor (ICEMultiDocObserver)
* Automatic insertion is handled in TCESynMemo.KeyUp() * Automatic insertion is handled in TCESynMemo.KeyUp()
*) *)
TCEStaticEditorMacro = class(TWritableComponent, ICEMultiDocObserver) TCEStaticEditorMacro = class(TWritableLfmTextComponent, ICEMultiDocObserver)
private private
fCompletor: TSynAutoComplete; fCompletor: TSynAutoComplete;
fMacros: TStringList; fMacros: TStringList;

View File

@ -24,7 +24,7 @@ type
property nestedIndex: Integer read fNestedIndex write fNestedIndex; property nestedIndex: Integer read fNestedIndex write fNestedIndex;
end; end;
TCESynMemoCache = class(TWritableComponent) TCESynMemoCache = class(TWritableLfmTextComponent)
private private
fMemo: TCESynMemo; fMemo: TCESynMemo;
fFolds: TCollection; fFolds: TCollection;

View File

@ -6,15 +6,15 @@ interface
uses uses
Classes, SysUtils, FileUtil, process, menus, Classes, SysUtils, FileUtil, process, menus,
ce_common, ce_writableComponent, ce_interfaces, ce_observer; ce_common, ce_writableComponent, ce_interfaces, ce_observer, ce_inspectors;
type type
TCEToolItem = class(TCollectionItem) TCEToolItem = class(TCollectionItem)
private private
fProcess: TCheckedAsyncProcess; fProcess: TCheckedAsyncProcess;
fExecutable: string; fExecutable: TCEFilename;
fWorkingDir: string; fWorkingDir: TCEPathname;
fShowWin: TShowWindowOptions; fShowWin: TShowWindowOptions;
fOpts: TProcessOptions; fOpts: TProcessOptions;
fParameters: TStringList; fParameters: TStringList;
@ -32,8 +32,8 @@ type
published published
property toolAlias: string read fToolAlias write fToolAlias; property toolAlias: string read fToolAlias write fToolAlias;
property options: TProcessOptions read fOpts write fOpts; property options: TProcessOptions read fOpts write fOpts;
property executable: string read fExecutable write fExecutable; property executable: TCEFilename read fExecutable write fExecutable;
property workingDirectory: string read fWorkingDir write fWorkingDir; property workingDirectory: TCEPathname read fWorkingDir write fWorkingDir;
property parameters: TStringList read fParameters write setParameters; property parameters: TStringList read fParameters write setParameters;
property showWindows: TShowWindowOptions read fShowWin write fShowWin; property showWindows: TShowWindowOptions read fShowWin write fShowWin;
property queryParameters: boolean read fQueryParams write fQueryParams; property queryParameters: boolean read fQueryParams write fQueryParams;
@ -45,7 +45,7 @@ type
destructor destroy; override; destructor destroy; override;
end; end;
TCETools = class(TWritableComponent, ICEMainMenuProvider) TCETools = class(TWritableLfmTextComponent, ICEMainMenuProvider)
private private
fTools: TCollection; fTools: TCollection;
function getTool(index: Integer): TCEToolItem; function getTool(index: Integer): TCEToolItem;

View File

@ -5,17 +5,20 @@ unit ce_writableComponent;
interface interface
uses uses
Classes, SysUtils, ce_common; Classes, SysUtils, ce_common, typinfo, fpjson, jsonparser, fpjsonrtti, fpjsondataset;
type type
(** (**
* The ancestor of classes which can be saved or reloaded to/from * The ancestor of classes which can be saved or reloaded to/from a file.
* a text file. It's used each time some options or data have to * It's used each time some options or data have to
* persist from a cession to another, independently from the centralized * persist from a cession to another, independently from the centralized
* system provided by the ICESessionOptionObserver/Subject mechanism. * 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 protected
fFilename: string; fFilename: string;
fHasLoaded: boolean; fHasLoaded: boolean;
@ -25,10 +28,8 @@ type
procedure beforeSave; virtual; procedure beforeSave; virtual;
procedure afterLoad; virtual; procedure afterLoad; virtual;
procedure afterSave; virtual; procedure afterSave; virtual;
procedure readerPropNoFound(Reader: TReader; Instance: TPersistent; procedure customLoadFromFile(const aFilename: string); virtual; abstract;
var PropName: string; IsPath: boolean; var Handled, Skip: Boolean); virtual; procedure customSaveToFile(const aFilename: string); virtual; abstract;
procedure readerError(Reader: TReader; const Message: string;
var Handled: Boolean); virtual;
public public
procedure saveToFile(const aFilename: string); virtual; procedure saveToFile(const aFilename: string); virtual;
procedure loadFromFile(const aFilename: string); virtual; procedure loadFromFile(const aFilename: string); virtual;
@ -38,49 +39,66 @@ type
property hasSaved: boolean read fHasSaved; property hasSaved: boolean read fHasSaved;
end; 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 implementation
procedure TWritableComponent.beforeSave; {$REGION TCustomWritableComponent ----------------------------------------------}
procedure TCustomWritableComponent.beforeSave;
begin begin
end; end;
procedure TWritableComponent.beforeLoad; procedure TCustomWritableComponent.beforeLoad;
begin begin
end; end;
procedure TWritableComponent.afterLoad; procedure TCustomWritableComponent.afterLoad;
begin begin
end; end;
procedure TWritableComponent.afterSave; procedure TCustomWritableComponent.afterSave;
begin begin
end; end;
procedure TWritableComponent.setFilename(const aValue: string); procedure TCustomWritableComponent.setFilename(const aValue: string);
begin begin
fFilename := aValue; fFilename := aValue;
end; end;
procedure TWritableComponent.readerPropNoFound(Reader: TReader; Instance: TPersistent; procedure TCustomWritableComponent.saveToFile(const aFilename: string);
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);
begin begin
fHasSaved := true; fHasSaved := true;
beforeSave; beforeSave;
try try
saveCompToTxtFile(self, aFilename); customSaveToFile(aFilename);
except except
fHasSaved := false; fHasSaved := false;
end; end;
@ -88,15 +106,95 @@ begin
afterSave; afterSave;
end; end;
procedure TWritableComponent.loadFromFile(const aFilename: string); procedure TCustomWritableComponent.loadFromFile(const aFilename: string);
begin begin
fHasLoaded := true; fHasLoaded := true;
beforeLoad; beforeLoad;
setFilename(aFilename); setFilename(aFilename);
loadCompFromTxtFile(self, aFilename, @readerPropNoFound, @readerError); customLoadFromFile(aFilename);
afterLoad; afterLoad;
end; 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 initialization
registerClasses([TWritableComponent]); registerClasses([TCustomWritableComponent, TWritableLfmTextComponent, TWritableJsonComponent]);
end. end.