forks
/
dexed
mirror of https://gitlab.com/basile.b/dexed.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

r27

This commit is contained in:
Basile Burg 2014-08-22 08:20:48 +02:00
parent 9e202f7c52
commit 6550dec0c4
29 changed files with 350 additions and 269 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
RevisionLog.txt
View File

@ -1,6 +1,13 @@
Revision log.
(single changes can be tracked with the GH commit messages)
r27:
- all sources: common defines are set by ce_defines.inc
- ce_dmdwrap.pas: every option likely to represent a path can contain a symbolic string.
- ce_project: added a routine for patching invalid sources.
- all sources: session options use the application-wide subject/observer system.
- ce_main: expandSymbolicString, only empty results are back-quoted.
r26:
- ce_libmaneditor: added support for folder of library (e.g derelict).
- ce_main: run project, fix, projects couldn't be executed when not saved.

7
lazproj/coedit.lpi
View File

@ -135,7 +135,7 @@
<PackageName Value="LCL"/>
</Item6>
</RequiredPackages>
<Units Count="25">
<Units Count="26">
<Unit0>
<Filename Value="coedit.lpr"/>
<IsPartOfProject Value="True"/>
@ -291,6 +291,11 @@
<IsPartOfProject Value="True"/>
<UnitName Value="ce_writableComponent"/>
</Unit24>
<Unit25>
<Filename Value="..\src\ce_options.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ce_options"/>
</Unit25>
</Units>
</ProjectOptions>
<CompilerOptions>

2
lazproj/coedit.lpr
View File

@ -7,7 +7,7 @@ uses
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, Forms, lazcontrols, runtimetypeinfocontrols,
ce_dcd, ce_observer, ce_main, ce_writableComponent;
ce_dcd, ce_observer, ce_main, ce_writableComponent, ce_options;
{$R *.res}

54
src/ce_common.pas
View File

@ -1,6 +1,6 @@
unit ce_common;
{$MODE OBJFPC}{$H+}
{$I ce_defines.inc}
interface
@ -13,6 +13,9 @@ uses
const
DdiagFilter = 'D source|*.d|D interface|*.di|All files|*.*';
exeExt = {$IFDEF WINDOWS} '.exe' {$ELSE} '' {$ENDIF};
objExt = {$IFDEF WINDOWS} '.obj' {$ELSE} '.o' {$ENDIF};
libExt = {$IFDEF WINDOWS} '.lib' {$ELSE} '.a' {$ENDIF};
var
DExtList: TStringList;
@ -59,6 +62,24 @@ type
procedure Assign(aValue: TPersistent);
end;
(**
* Makes TReader.ReadProperties visible
*)
TReaderEx = class helper for TReader
public
procedure ReadPersistent(aValue: TPersistent);
end;
(**
* Makes TWriter.WriteProperties visible
* W
*)
TWriterEx = class helper for TWriter
public
// works as bin but raises because of 'ObjectBinaryToText'
procedure WritePersistent(aValue: TPersistent);
end;
(**
* Save a component with a readable aspect.
*)
@ -159,6 +180,8 @@ type
implementation
// https://stackoverflow.com/questions/25438091/objectbinarytotext-error-with-a-treader-twriter-helper-class
// http://forum.lazarus.freepascal.org/index.php/topic,25557.0.html
procedure TProcessEx.Assign(aValue: TPersistent);
var
src: TProcess;
@ -190,6 +213,20 @@ begin
else inherited;
end;
procedure TReaderEx.ReadPersistent(aValue: TPersistent);
begin
ReadListBegin;
while not EndOfList do ReadProperty(aValue);
ReadListEnd;
end;
procedure TWriterEx.WritePersistent(aValue: TPersistent);
begin
WriteListBegin;
WriteProperties(aValue);
WriteListEnd;
end;
constructor TMRUList.Create;
begin
fMaxCount := 10;
@ -337,14 +374,10 @@ begin
result := patchProc(result, '/');
result := patchProc(result, ':');
{$ENDIF}
{$IFDEF LINUX}
{$IFDEF POSIX}
result := patchProc(result, '\');
result := patchProc(result, ':');
{$ENDIF}
{$IFDEF MACOS}
result := patchProc(result, '\');
result := patchProc(result, '/');
{$ENDIF}
end;
procedure patchPlateformPaths(const sPaths: TStrings);
@ -607,20 +640,17 @@ begin
end;
function exeInSysPath(anExeName: string): boolean;
{$IFDEF WINDOWS}
var
ext: string;
{$ENDIF}
begin
{$IFDEF WINDOWS}
ext := extractFileExt(anExeName);
if ext = '' then
anExeName += '.exe';
{$ENDIF}
if ext <> exeExt then
anExeName += exeExt;
exit(ExeSearch(anExeName, '') <> '');
end;
initialization
RegisterClasses([TMRUList, TMRUFileList]);
DExtList := TStringList.Create;
DExtList.Add('.d');
DExtList.Add('.di');

3
src/ce_customtools.pas
View File

@ -1,7 +1,6 @@
unit ce_customtools;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface

2
src/ce_d2syn.pas
View File

@ -1,6 +1,6 @@
unit ce_d2syn;
{$MODE OBJFPC}{$H+}
{$I ce_defines.inc}
interface

11
src/ce_dcd.pas
View File

@ -1,10 +1,11 @@
unit ce_dcd;
{$MODE OBJFPC}{$H+}
{$I ce_defines.inc}
interface
uses
Classes, SysUtils, process, forms, strutils;
Classes, SysUtils, process, forms, strutils, ce_common;
(**
@ -67,8 +68,7 @@ begin
if DCD_server <> nil then
FreeAndNil(DCD_server);
DCD_server := TProcess.Create(nil);
DCD_server.Executable := extractFilePath(application.ExeName) + directorySeparator
+ 'dcd-server'{$IFDEF WINDOWS}+ '.exe'{$ENDIF};
DCD_server.Executable := extractFilePath(application.ExeName) + directorySeparator + 'dcd-server' + exeExt;
DCD_server.Options := [poUsePipes{$IFDEF WINDOWS}, poNewConsole{$ENDIF}];
DCD_server.ShowWindow := swoHIDE;
end;
@ -192,8 +192,7 @@ end;
initialization
createServer;
DCD_client := TProcess.Create(nil);
DCD_client.Executable := extractFilePath(application.ExeName) + directorySeparator
+ 'dcd-client'{$IFDEF WINDOWS}+ '.exe'{$ENDIF};
DCD_client.Executable := extractFilePath(application.ExeName) + directorySeparator + 'dcd-client' + exeExt;
DCD_client.Options := [poUsePipes{$IFDEF WINDOWS}, poNewConsole{$ENDIF}];
DCD_client.ShowWindow := swoHIDE;
dcdOn := fileExists(DCD_server.Executable) and fileExists(DCD_client.Executable);

2
src/ce_defines.inc Normal file
View File

@ -0,0 +1,2 @@
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}

2
src/ce_dlang.pas
View File

@ -1,6 +1,6 @@
unit ce_dlang;
{$MODE OBJFPC}{$H+}
{$I ce_defines.inc}
interface

2
src/ce_dlangutils.pas
View File

@ -1,6 +1,6 @@
unit ce_dlangutils;
{$MODE OBJFPC}{$H+}
{$I ce_defines.inc}
interface

16
src/ce_dmdwrap.pas
View File

@ -1,6 +1,6 @@
unit ce_dmdwrap;
{$MODE OBJFPC}{$H+}
{$I ce_defines.inc}
interface
@ -361,8 +361,8 @@ procedure TDocOpts.getOpts(const aList: TStrings);
begin
if fGenDoc then aList.Add('-D');
if fGenJson then aList.Add('-X');
if fDocDir <> '' then aList.Add('-Dd' + fDocDir);
if fJsonFname <> '' then aList.Add('-Xf' + fJsonFname);
if fDocDir <> '' then aList.Add('-Dd' + CEMainForm.expandSymbolicString(fDocDir));
if fJsonFname <> '' then aList.Add('-Xf' + CEMainForm.expandSymbolicString(fJsonFname));
end;
procedure TDocOpts.assign(aValue: TPersistent);
@ -816,13 +816,13 @@ begin
aList.Add(str);
end;
for str in fIncl do if str <> '' then
aList.Add('-I'+ str);
aList.Add('-I'+ CEMainForm.expandSymbolicString(str));
for str in fImpt do if str <> '' then
aList.Add('-J'+ str);
aList.Add('-J'+ CEMainForm.expandSymbolicString(str));
if fFname <> '' then
aList.Add('-of' + fFname);
aList.Add('-of' + CEMainForm.expandSymbolicString(fFname));
if fObjDir <> '' then
aList.Add('-od' + fObjDir);
aList.Add('-od' + CEMainForm.expandSymbolicString(fObjDir));
end;
procedure TPathsOpts.assign(aValue: TPersistent);
@ -920,7 +920,7 @@ begin
str2 := '-' + str1
else
str2 := str1;
aList.Add(str2);
aList.Add(CEMainForm.expandSymbolicString(str2));
end;
end;

3
src/ce_editor.pas
View File

@ -1,7 +1,6 @@
unit ce_editor;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface

98
src/ce_interfaces.pas
View File

@ -1,27 +1,33 @@
unit ce_interfaces;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface
uses
Classes, SysUtils, actnList, menus, ce_synmemo, ce_project, ce_observer;
type
(**
* An implementer can save and load some stuffs on application start/quit
*)
ICEWidgetPersist = interface
ICESessionOptionsObserver = interface
['ICEWidgetPersist']
// Coedit options are about to be saved.
procedure beforeSave(sender: TObject);
// some custom properties can be declared to aFiler.
procedure declareProperties(aFiler: TFiler);
// Coedit options has just been reloaded.
procedure afterLoad(sender: TObject);
// persistent things are about to be saved.
procedure sesoptBeforeSave;
// persistent things can be declared to aFiler.
procedure sesoptDeclareProperties(aFiler: TFiler);
// persistent things have just been reloaded.
procedure sesoptAfterLoad;
end;
(**
* An implementer gets and gives back some things
*)
TCESessionOptionsSubject = class(TCECustomSubject)
protected
function acceptObserver(aObject: TObject): boolean; override;
end;
(**
@ -73,10 +79,6 @@ type
procedure projClosing(const aProject: TCEProject);
// not used yet: the active project is now aProject
procedure projFocused(const aProject: TCEProject);
// aProject is about to be compiled.
//procedure projCompile(const aProject: TCEProject);
// aProject is about to be executed.
//procedure projRun(const aProject: TCEProject);
end;
(**
@ -94,7 +96,7 @@ type
['ICEMainMenuProvider']
// item must contain the full items tree to be added
procedure menuDeclare(out item: TMenuItem);
// the implementer can update the actions used in the menu declared before.
// the implementer can update the actions used in the menu declared previously.
procedure menuActionsUpdate;
end;
@ -102,7 +104,7 @@ type
{
subject Primitives:
A subject has not necessarly all the informations the observers expect.
A subject cannot necessarly provides all the informations the observers expect.
It can compose using the following "primitives".
}
@ -123,17 +125,19 @@ type
procedure subjProjFocused(aSubject: TCEProjectSubject; aProj: TCEProject); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjProjChanged(aSubject: TCEProjectSubject; aProj: TCEProject); {$IFDEF RELEASE}inline;{$ENDIF}
//procedure subjProjCompile(aSubject: TCEProjectSubject; aProj: TCEProject); //{$IFDEF RELEASE}inline;{$ENDIF}
//procedure subjProjRun(aSubject: TCEProjectSubject; aProj: TCEProject); //{$IFDEF RELEASE}inline;{$ENDIF}
(**
* TCESessionOptionsSubject primitives.
*)
procedure subjSesOptsBeforeSave(aSubject: TCESessionOptionsSubject); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjSesOptsDeclareProperties(aSubject: TCESessionOptionsSubject; aFiler: TFiler);{$IFDEF RELEASE}inline;{$ENDIF}
procedure subjSesOptsAfterLoad(aSubject: TCESessionOptionsSubject); {$IFDEF RELEASE}inline;{$ENDIF}
implementation
uses
ce_main;
{$REGION TCEMultiDocSubject-----------------------------------------------------}
function TCEMultiDocSubject.acceptObserver(aObject: TObject): boolean;
begin
result := (aObject is ICEMultiDocObserver);
exit(aObject is ICEMultiDocObserver);
end;
procedure subjDocNew(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo);
@ -167,12 +171,12 @@ begin
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICEMultiDocObserver).docChanged(aDoc);
end;
{$ENDREGION}
{$REGION TCEProjectSubject------------------------------------------------------}
function TCEProjectSubject.acceptObserver(aObject: TObject): boolean;
begin
result := (aObject is ICEProjectObserver);
exit(aObject is ICEProjectObserver);
end;
procedure subjProjNew(aSubject: TCEProjectSubject; aProj: TCEProject);
@ -206,24 +210,36 @@ begin
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICEProjectObserver).projChanged(aProj);
end;
{$ENDREGION}
{$REGION TCESessionOptionsSubject------------------------------------------------------}
function TCESessionOptionsSubject.acceptObserver(aObject: TObject): boolean;
begin
exit(aObject is ICESessionOptionsObserver);
end;
procedure subjSesOptsBeforeSave(aSubject: TCESessionOptionsSubject);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICESessionOptionsObserver).sesoptBeforeSave;
end;
//procedure subjProjCompile(aSubject: TCEProjectSubject; aProj: TCEProject);
//var
// i: Integer;
//begin
// with aSubject do for i:= 0 to fObservers.Count-1 do
// (fObservers.Items[i] as ICEProjectObserver).projCompile(aProj);
//end;
//
//procedure subjProjRun(aSubject: TCEProjectSubject; aProj: TCEProject);
//var
// i: Integer;
//begin
// with aSubject do for i:= 0 to fObservers.Count-1 do
// (fObservers.Items[i] as ICEProjectObserver).projRun(aProj);
//end;
procedure subjSesOptsDeclareProperties(aSubject: TCESessionOptionsSubject; aFiler: TFiler);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICESessionOptionsObserver).sesoptDeclareProperties(aFiler);
end;
procedure subjSesOptsAfterLoad(aSubject: TCESessionOptionsSubject);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICESessionOptionsObserver).sesoptAfterLoad;
end;
{$ENDREGION}
end.

9
src/ce_libman.pas
View File

@ -1,7 +1,6 @@
unit ce_libman;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface
@ -107,11 +106,7 @@ begin
listFiles(lst, itm.libFile);
for j:= 0 to lst.Count-1 do
begin
{$IFDEF WINDOWS}
if extractFileExt(lst.Strings[j]) = '.lib' then
{$ELSE}
if extractFileExt(lst.Strings[j]) = '.a' then
{$ENDIF}
if extractFileExt(lst.Strings[j]) = libExt then
if aList.IndexOf(lst.Strings[j]) = -1 then
aList.Add(lst.Strings[j]);
end;

3
src/ce_libmaneditor.pas
View File

@ -1,7 +1,6 @@
unit ce_libmaneditor;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface

188
src/ce_main.pas
View File

@ -1,7 +1,6 @@
unit ce_main;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface
@ -16,40 +15,13 @@ uses
type
TCEMainForm = class;
// TODO-cfeature: input handling
// TODO-cfeature: options
// TODO-cwidget: options editor
// TODO-cwidget: custom tools editor
// TODO-cfeature: tools menu
(**
* Encapsulates the options in a writable component.
*)
TCEOptions = class(TWritableComponent)
private
fFileMru, fProjMru: TMruFileList;
fLeft, FTop, fWidth, fHeight: Integer;
procedure setFileMru(aValue: TMruFileList);
procedure setProjMru(aValue: TMruFileList);
published
property APP_Left: Integer read fLeft write fLeft;
property APP_Top: Integer read fTop write fTop;
property APP_Width: Integer read fWidth write fWidth;
property APP_Height: Integer read fHeight write fHeight;
//
property MRU_Files: TMruFileList read fFileMru write setFileMru;
property MRU_Projects: TMruFileList read fProjMru write setProjMru;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
procedure defineProperties(Filer: TFiler); override;
procedure beforeSave; override;
procedure afterLoad; override;
end;
{ TCEMainForm }
TCEMainForm = class(TForm, ICEMultiDocObserver)
TCEMainForm = class(TForm, ICEMultiDocObserver, ICESessionOptionsObserver)
actFileCompAndRun: TAction;
actFileSaveAll: TAction;
actFileClose: TAction;
@ -222,6 +194,19 @@ type
procedure docFocused(const aDoc: TCESynMemo);
procedure docChanged(const aDoc: TCESynMemo);
// ICESessionOptionsObserver
procedure sesoptBeforeSave;
procedure sesoptDeclareProperties(aFiler: TFiler);
procedure sesoptAfterLoad;
procedure optget_FileMRUItems(aWriter: TWriter);
procedure optset_FileMRUItems(aReader: TReader);
procedure optget_FileMRULimit(aWriter: TWriter);
procedure optset_FileMRULimit(aReader: TReader);
procedure optget_ProjMRUItems(aWriter: TWriter);
procedure optset_ProjMRUItems(aReader: TReader);
procedure optget_ProjMRULimit(aWriter: TWriter);
procedure optset_ProjMRULimit(aReader: TReader);
//Init - Fina
procedure getCMdParams;
procedure checkCompilo;
@ -290,7 +275,7 @@ implementation
{$R *.lfm}
uses
SynMacroRecorder, strutils;
SynMacroRecorder, strutils, ce_options;
{$REGION Standard Comp/Obj------------------------------------------------------}
constructor TCEMainForm.create(aOwner: TComponent);
@ -528,8 +513,8 @@ var
fname2: string;
opts: TCEOptions;
begin
fname1 := getDocPath + 'options.txt';
fname2 := getDocPath + 'options.bak';
fname1 := getDocPath + 'options2.txt';
fname2 := getDocPath + 'options2.bak';
opts := TCEOptions.create(nil);
try
if fileExists(fname1) then
@ -557,7 +542,7 @@ begin
forceDirectory(getDocPath);
fLibMan.saveToFile(getDocPath + 'libraryManager.txt');
fTools.saveToFile(getDocPath + 'tools.txt');
opts.saveToFile(getDocPath + 'options.txt');
opts.saveToFile(getDocPath + 'options2.txt');
finally
opts.Free;
end;
@ -667,7 +652,6 @@ end;
destructor TCEMainForm.destroy;
begin
EntitiesConnector.removeObserver(self);
SaveSettings;
//
KillPlugs;
@ -677,6 +661,7 @@ begin
fFileMru.Free;
fProject.Free;
//
EntitiesConnector.removeObserver(self);
inherited;
end;
@ -1241,7 +1226,7 @@ begin
dmdproc.Parameters.Add(editor.fileName);
dmdproc.Parameters.Add('-w');
dmdproc.Parameters.Add('-wi');
dmdproc.Parameters.Add('-of' + fname {$IFDEF WINDOWS}+ '.exe'{$ENDIF});
dmdproc.Parameters.Add('-of' + fname + exeExt);
LibraryManager.getLibFiles(nil, dmdproc.Parameters);
LibraryManager.getLibSources(nil, dmdproc.Parameters);
dmdproc.Execute;
@ -1253,16 +1238,11 @@ begin
runproc.Options := [poStderrToOutPut, poUsePipes];
runproc.CurrentDirectory := extractFilePath(runProc.Executable);
runproc.Parameters.DelimitedText := expandSymbolicString(runArgs);
runproc.Executable := fname {$IFDEF WINDOWS}+ '.exe'{$ENDIF};
runproc.Executable := fname + exeExt;
runproc.Execute;
repeat ProcessOutputToMsg(runproc, mcEditor) until not runproc.Running;
{$IFDEF MSWINDOWS}
sysutils.DeleteFile(fname + '.exe');
sysutils.DeleteFile(fname + '.obj');
{$ELSE}
sysutils.DeleteFile(fname);
sysutils.DeleteFile(fname + '.o');
{$ENDIF}
sysutils.DeleteFile(fname + exeExt);
sysutils.DeleteFile(fname + objExt);
end
else begin
ProcessOutputToMsg(dmdproc, mcEditor);
@ -1285,9 +1265,6 @@ begin
fMesgWidg.ClearAllMessages;
//for i := 0 to fWidgList.Count-1 do
//fWidgList.widget[i].projCompile(aProject);
with fProject.currentConfiguration do
begin
if preBuildProcess.executable <> '' then
@ -1383,9 +1360,6 @@ begin
if aProject.currentConfiguration.outputOptions.binaryKind <>
executable then exit;
//for i := 0 to fWidgList.Count-1 do
//fWidgList.widget[i].projRun(aProject);
runproc := TProcess.Create(nil);
try
aProject.currentConfiguration.runOptions.setProcess(runProc);
@ -1675,80 +1649,61 @@ begin
end;
{$ENDREGION}
{$REGION options ---------------------------------------------------------------}
constructor TCEOptions.create(aOwner: TComponent);
{$REGION ICESessionOptionsObserver ----------------------------------------------------}
procedure TCEMainForm.sesoptBeforeSave;
begin
inherited;
fFileMru := TMruFileList.Create;
fProjMru := TMruFileList.Create;
//
fLeft := 0;
fTop := 0;
fWidth := 800;
fHeight := 600;
end;
destructor TCEOptions.destroy;
procedure TCEMainForm.sesoptDeclareProperties(aFiler: TFiler);
begin
fFileMru.Free;
fProjMru.Free;
inherited;
aFiler.DefineProperty('Menu_FileMRU_Items', @optset_FileMRUItems, @optget_FileMRUItems, true);
aFiler.DefineProperty('Menu_FileMRU_Limit', @optset_FileMRULimit, @optget_FileMRULimit, true);
aFiler.DefineProperty('Menu_ProjMRU_Items', @optset_ProjMRUItems, @optget_ProjMRUItems, true);
aFiler.DefineProperty('Menu_ProjMRU_Limit', @optset_ProjMRULimit, @optget_ProjMRULimit, true);
end;
procedure TCEOptions.setFileMru(aValue: TMruFileList);
procedure TCEMainForm.sesoptAfterLoad;
begin
fFileMru.Assign(aValue);
end;
procedure TCEOptions.setProjMru(aValue: TMruFileList);
procedure TCEMainForm.optget_FileMRUItems(aWriter: TWriter);
begin
fProjMru.Assign(aValue);
aWriter.WriteString(fFileMru.DelimitedText);
end;
procedure TCEOptions.defineProperties(Filer: TFiler);
var
i: NativeInt;
procedure TCEMainForm.optset_FileMRUItems(aReader: TReader);
begin
inherited;
// Filer is either a TReader or a TWriter
for i := 0 to CEMainForm.WidgetList.Count-1 do
CEMainForm.WidgetList.widget[i].declareProperties(Filer);
fFileMru.DelimitedText := aReader.ReadString;
end;
procedure TCEOptions.beforeSave;
var
i: NativeInt;
procedure TCEMainForm.optget_FileMRULimit(aWriter: TWriter);
begin
fLeft := CEMainForm.Left;
fTop := CEMainForm.Top;
fWidth := CEMainForm.Width;
fHeight := CEMainForm.Height;
//
fFileMru.Assign(CEMainForm.fFileMru);
fProjMru.Assign(CEMainForm.fProjMru);
//
for i := 0 to CEMainForm.WidgetList.Count-1 do
CEMainForm.WidgetList.widget[i].beforeSave(nil);
aWriter.WriteInteger(fFileMru.maxCount);
end;
procedure TCEOptions.afterLoad;
var
i: NativeInt;
procedure TCEMainForm.optset_FileMRULimit(aReader: TReader);
begin
CEMainForm.Left := fLeft;
CEMainForm.Top := fTop;
CEMainForm.Width := fWidth;
CEMainForm.Height := fHeight;
if fLeft < 0 then fLeft := 0;
if fTop < 0 then fTop := 0;
if fWidth < 800 then fWidth := 800;
if fHeight < 600 then fWidth := 600;
//
CEMainForm.fFileMru.Assign(fFileMru);
CEMainForm.fProjMru.Assign(fProjMru);
//
for i := 0 to CEMainForm.WidgetList.Count-1 do
CEMainForm.WidgetList.widget[i].afterLoad(nil);
fFileMru.maxCount := aReader.ReadInteger;
end;
procedure TCEMainForm.optget_ProjMRUItems(aWriter: TWriter);
begin
aWriter.WriteString(fProjMru.DelimitedText);
end;
procedure TCEMainForm.optset_ProjMRUItems(aReader: TReader);
begin
fProjMru.DelimitedText := aReader.ReadString;
end;
procedure TCEMainForm.optget_ProjMRULimit(aWriter: TWriter);
begin
aWriter.WriteInteger(fProjMru.maxCount);
end;
procedure TCEMainForm.optset_ProjMRULimit(aReader: TReader);
begin
fProjMru.maxCount := aReader.ReadInteger;
end;
{$ENDREGION}
@ -1760,7 +1715,7 @@ var
i: integer;
begin
if symString = '' then
exit(symString);
exit('``');
result := '';
elems := TStringList.Create;
@ -1798,62 +1753,55 @@ begin
continue;
'CPF', 'CurrentProjectFile':
begin
result += '`';
if fProject <> nil then
if fileExists(fProject.fileName) then
result += fProject.fileName;
result += '`';
end;
'CPP', 'CurrentProjectPath':
begin
result += '`';
if fProject <> nil then
if fileExists(fProject.fileName) then
result += extractFilePath(fProject.fileName);
result += '`';
end;
'CPR', 'CurrentProjectRoot':
begin
result += '`';
if fProject <> nil then
if directoryExists(fProject.getAbsoluteFilename(fProject.RootFolder)) then
result += fProject.getAbsoluteFilename(fProject.RootFolder)
else if directoryExists(fProject.RootFolder) then
result += fProject.RootFolder;
result += '`';
end;
'CFF', 'CurrentFileFile':
begin
result += '`';
if fDoc <> nil then
if fileExists(fDoc.fileName) then
result += fDoc.fileName;
result += '`';
end;
'CFP', 'CurrentFilePath':
begin
result += '`';
if fDoc <> nil then
if fileExists(fDoc.fileName) then
result += extractFilePath(fDoc.fileName);
result += '`';
end;
'CI', 'CurrentIdentifier':
begin
result += '`';
if fDoc <> nil then
result += fDoc.Identifier;
result += '`';
end;
'CAF', 'CoeditApplicationFile':
result += '`' + application.ExeName + '`';
result += application.ExeName;
'CAP', 'CoeditApplicationPath':
result += '`' + extractFilePath(Application.ExeName) + '`';
result += extractFilePath(Application.ExeName);
end;
end;
finally
elems.Free;
end;
// as the result may be used in TProcess.Parameter, it has not to be empty
// otherwise next parameter switch can be considered as the parameter value,
// eg --a=<CI> --b --c, the program will think that --b is --a value if <CI> is empty.
if result = '' then
result += '``';
end;
procedure PlugDispatchToHost(aPlugin: TCEPlugin; opCode: LongWord; data0: Integer; data1, data2: Pointer); cdecl;

9
src/ce_messages.pas
View File

@ -1,7 +1,6 @@
unit ce_messages;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface
@ -62,7 +61,7 @@ type
procedure addCeErr(const aMsg: string; aCtxt: TMessageContext = mcUnknown);
procedure addCeWarn(const aMsg: string; aCtxt: TMessageContext = mcUnknown);
//
procedure declareProperties(aFiler: TFiler); override;
procedure sesoptDeclareProperties(aFiler: TFiler); override;
//
function contextName: string; override;
function contextActionCount: integer; override;
@ -154,7 +153,7 @@ begin
end;
{$ENDREGION}
{$REGION ICEWidgetPersist ------------------------------------------------------}
{$REGION ICESessionOptionsObserver ------------------------------------------------------}
procedure TCEMessagesWidget.setMaxMessageCount(aValue: Integer);
begin
if aValue < 10 then aValue := 10;
@ -174,7 +173,7 @@ begin
aWriter.WriteInteger(fMaxMessCnt);
end;
procedure TCEMessagesWidget.declareProperties(aFiler: TFiler);
procedure TCEMessagesWidget.sesoptDeclareProperties(aFiler: TFiler);
begin
inherited;
aFiler.DefineProperty(Name + '_MaxMessageCount', @optset_MaxMessageCount, @optget_MaxMessageCount, true);

7
src/ce_miniexplorer.pas
View File

@ -1,7 +1,6 @@
unit ce_miniexplorer;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface
@ -55,7 +54,7 @@ type
constructor create(aIwner: TComponent); override;
destructor destroy; override;
//
procedure declareProperties(aFiler: TFiler); override;
procedure sesoptDeclareProperties(aFiler: TFiler); override;
//
procedure expandPath(const aPath: string);
end;
@ -100,7 +99,7 @@ end;
{$ENDREGION}
{$REGION ICEWidgetPersist ------------------------------------------------------}
procedure TCEMiniExplorerWidget.declareProperties(aFiler: TFiler);
procedure TCEMiniExplorerWidget.sesoptDeclareProperties(aFiler: TFiler);
begin
inherited;
aFiler.DefineProperty(Name + '_LastFolder', @optset_LastFold, @optget_LastFold, true);

3
src/ce_observer.pas
View File

@ -1,7 +1,6 @@
unit ce_observer;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface

62
src/ce_options.pas Normal file
View File

@ -0,0 +1,62 @@
unit ce_options;
{$I ce_defines.inc}
interface
uses
classes, sysutils, ce_common, ce_writableComponent, ce_observer;
type
TCEOptions = class(TWritableComponent)
private
fSubjPersObservers: TCECustomSubject;
protected
procedure defineProperties(Filer: TFiler); override;
procedure beforeSave; override;
procedure afterLoad; override;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
end;
implementation
uses
ce_interfaces;
constructor TCEOptions.create(aOwner: TComponent);
begin
inherited;
fSubjPersObservers := TCESessionOptionsSubject.create;
//
EntitiesConnector.addSubject(fSubjPersObservers);
EntitiesConnector.endUpdate;
end;
destructor TCEOptions.destroy;
begin
EntitiesConnector.removeSubject(fSubjPersObservers);
EntitiesConnector.endUpdate;
//
fSubjPersObservers.Free;
inherited;
end;
procedure TCEOptions.defineProperties(Filer: TFiler);
begin
subjSesOptsDeclareProperties(TCESessionOptionsSubject(fSubjPersObservers), Filer);
end;
procedure TCEOptions.beforeSave;
begin
subjSesOptsBeforeSave(TCESessionOptionsSubject(fSubjPersObservers));
end;
procedure TCEOptions.afterLoad;
begin
subjSesOptsAfterLoad(TCESessionOptionsSubject(fSubjPersObservers));
end;
end.

3
src/ce_plugin.pas
View File

@ -1,7 +1,6 @@
unit ce_plugin;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface

3
src/ce_projconf.pas
View File

@ -1,7 +1,6 @@
unit ce_projconf;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface

52
src/ce_project.pas
View File

@ -1,7 +1,6 @@
unit ce_project;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface
@ -77,7 +76,7 @@ type
implementation
uses
ce_interfaces;
ce_interfaces, controls, dialogs;
constructor TCEProject.create(aOwner: TComponent);
begin
@ -301,10 +300,7 @@ begin
end;
result := extractFilename(Sources.Strings[0]);
result := result[1..length(result) - length(extractFileExt(result))];
result := extractFilePath(fileName) + DirectorySeparator + result;
{$IFDEF MSWINDOWS}
result += '.exe';
{$ENDIF}
result := extractFilePath(fileName) + DirectorySeparator + result + exeExt;
end;
procedure TCEProject.getOpts(const aList: TStrings);
@ -345,10 +341,52 @@ begin
end;
procedure TCEProject.afterLoad;
var
i, j: Integer;
src, ini, newdir: string;
begin
patchPlateformPaths(fSrcs);
doChanged;
fModified := false;
// patch location: this only works when the project file is moved.
// if the source structure changes this doesn't help much.
// if both appends then the project must be restarted from scratch.
for i := 0 to fSrcs.Count-1 do
begin
src := getAbsoluteSourceName(i);
if fileExists(src) then
continue;
if ce_common.dlgOkCancel(
'The project source(s) point to invalid file(s). ' + LineEnding +
'This can be encountered if the project file has been moved from its original location.' + LineEnding + LineEnding +
'Do you wish to select the new root folder ?') <> mrOk then
exit;
// hint for the common dir
src := fSrcs.Strings[i];
while (src[1] = '.') or (src[1] = DirectorySeparator) do
src := src[2..length(src)];
// prompt
ini := extractFilePath(fFilename);
if not selectDirectory( format('select the folder (which contains "%s")',[src]), ini, newdir) then
exit;
// patch
for j := i to fSrcs.Count-1 do
begin
src := fSrcs.Strings[j];
while (src[1] = '.') or (src[1] = DirectorySeparator) do
src := src[2..length(src)];
if fileExists(expandFilenameEx(fBasePath, newdir + DirectorySeparator + src)) then
fSrcs.Strings[j] := ExtractRelativepath(fBasePath, newdir + DirectorySeparator + src)
else break; // next pass: patch from another folder.
end;
end;
//
saveToFile(fFilename);
// warning for other relative paths
if fileExists(getAbsoluteSourceName(0)) then
ce_common.dlgOkInfo('the main sources paths has been patched, some others invalid ' +
'paths may still exists (-of, -od, etc.) but cannot be automatically handled');
end;
procedure TCEProject.readerPropNoFound(Reader: TReader; Instance: TPersistent;

3
src/ce_projinspect.pas
View File

@ -1,7 +1,6 @@
unit ce_projinspect;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface

9
src/ce_search.pas
View File

@ -1,7 +1,6 @@
unit ce_search;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface
@ -62,7 +61,7 @@ type
function contextActionCount: integer; override;
function contextAction(index: integer): TAction; override;
//
procedure declareProperties(aFiler: TFiler); override;
procedure sesoptDeclareProperties(aFiler: TFiler); override;
//
procedure actFindNextExecute(sender: TObject);
procedure actReplaceNextExecute(sender: TObject);
@ -104,8 +103,8 @@ begin
end;
{$ENDREGION}
{$REGION ICEWidgetPersist ------------------------------------------------------}
procedure TCESearchWidget.declareProperties(aFiler: TFiler);
{$REGION ICESessionOptionsObserver ------------------------------------------------------}
procedure TCESearchWidget.sesoptDeclareProperties(aFiler: TFiler);
begin
inherited;
aFiler.DefineProperty(Name + '_FindMRU', @optset_SearchMru, @optget_SearchMru, true);

23
src/ce_staticexplorer.pas
View File

@ -1,7 +1,6 @@
unit ce_staticexplorer;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface
@ -74,12 +73,8 @@ type
procedure projClosing(const aProject: TCEProject);
procedure projFocused(const aProject: TCEProject);
procedure projChanged(const aProject: TCEProject);
procedure projCompile(const aProject: TCEProject); // warning: removed from itf
procedure projRun(const aProject: TCEProject); // warning: removed from itf
//
procedure declareProperties(aFiler: TFiler); override;
procedure sesoptDeclareProperties(aFiler: TFiler); override;
end;
implementation
@ -141,7 +136,7 @@ begin
end;
{$ENDREGION}
{$REGION ICEWidgetPersist ------------------------------------------------------}
{$REGION ICESessionOptionsObserver ------------------------------------------------------}
procedure TCEStaticExplorerWidget.optget_AutoRefresh(aWriter: TWriter);
begin
aWriter.WriteBoolean(fAutoRefresh);
@ -175,7 +170,7 @@ begin
fActRefreshOnFocus.Checked := fRefreshOnFocus;
end;
procedure TCEStaticExplorerWidget.declareProperties(aFiler: TFiler);
procedure TCEStaticExplorerWidget.sesoptDeclareProperties(aFiler: TFiler);
begin
inherited;
aFiler.DefineProperty(Name + '_AutoRefresh', @optset_AutoRefresh, @optget_AutoRefresh, true);
@ -278,16 +273,6 @@ procedure TCEStaticExplorerWidget.projChanged(const aProject: TCEProject);
begin
fProj := aProject;
end;
procedure TCEStaticExplorerWidget.projCompile(const aProject: TCEProject);
begin
stopUpdateByDelay; // warning: not triggered anymore
end;
procedure TCEStaticExplorerWidget.projRun(const aProject: TCEProject);
begin
stopUpdateByDelay; // warning: not triggered anymore
end;
{$ENDREGION}
procedure TCEStaticExplorerWidget.UpdateByDelay;

3
src/ce_synmemo.pas
View File

@ -1,7 +1,6 @@
unit ce_synmemo;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface

26
src/ce_widget.pas
View File

@ -1,7 +1,6 @@
unit ce_widget;
{$MODE OBJFPC}{$H+}
{$INTERFACES CORBA}
{$I ce_defines.inc}
interface
@ -15,7 +14,7 @@ type
* Base type for an UI module.
*)
PTCEWidget = ^TCEWidget;
TCEWidget = class(TForm, ICEContextualActions, ICEWidgetPersist)
TCEWidget = class(TForm, ICEContextualActions, ICESessionOptionsObserver)
Content: TPanel;
Back: TPanel;
contextMenu: TPopupMenu;
@ -70,9 +69,9 @@ type
function contextActionCount: integer; virtual;
function contextAction(index: integer): TAction; virtual;
//
procedure beforeSave(sender: TObject); virtual;
procedure declareProperties(aFiler: TFiler); virtual;
procedure afterLoad(sender: TObject); virtual;
procedure sesoptBeforeSave; virtual;
procedure sesoptDeclareProperties(aFiler: TFiler); virtual;
procedure sesoptAfterLoad; virtual;
//
// returns true if one of the three updater is processing.
property updating: boolean read fUpdating;
@ -102,6 +101,9 @@ type
implementation
{$R *.lfm}
uses
ce_observer;
{$REGION Standard Comp/Obj------------------------------------------------------}
constructor TCEWidget.create(aOwner: TComponent);
var
@ -123,29 +125,31 @@ begin
itm.Action := contextAction(i);
contextMenu.Items.Add(itm);
end;
PopupMenu := contextMenu;
EntitiesConnector.addObserver(self);
end;
destructor TCEWidget.destroy;
begin
EntitiesConnector.removeObserver(self);
inherited;
end;
{$ENDREGION}
{$REGION ICEWidgetPersist ------------------------------------------------------}
procedure TCEWidget.beforeSave(sender: TObject);
{$REGION ICESessionOptionsObserver ----------------------------------------------------}
procedure TCEWidget.sesoptBeforeSave;
begin
end;
procedure TCEWidget.declareProperties(aFiler: TFiler);
procedure TCEWidget.sesoptDeclareProperties(aFiler: TFiler);
begin
// override rules: inhertied must be called. No dots in the property name, property name prefixed with the widget Name
aFiler.DefineProperty(Name + '_updaterByLoopInterval', @optset_LoopInterval, @optget_LoopInterval, true);
aFiler.DefineProperty(Name + '_updaterByDelayDuration', @optset_UpdaterDelay, @optget_UpdaterDelay, true);
end;
procedure TCEWidget.afterLoad(sender: TObject);
procedure TCEWidget.sesoptAfterLoad;
begin
end;

5
src/ce_writablecomponent.pas
View File

@ -1,6 +1,6 @@
unit ce_writableComponent;
{$MODE OBJFPC}{$H+}
{$I ce_defines.inc}
interface
@ -12,7 +12,8 @@ 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
* persist from a cession to another.
* persist from a cession to another, independently from the centralized
* system provided by the ICESessionOptionObserver/Subject mechanism.
*)
TWritableComponent = class(TComponent)
protected