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

messages rewrite using internal observer system 1

This commit is contained in:
Basile Burg 2014-11-07 14:11:25 +01:00
parent 4ef06c984a
commit afabbb1b45
9 changed files with 293 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/ce_customtools.pas
View File

@ -5,12 +5,14 @@ unit ce_customtools;
interface
uses
Classes, SysUtils, process, ce_common, ce_writableComponent;
Classes, SysUtils, process, asyncprocess, ce_common, ce_writableComponent,
ce_interfaces, ce_observer;
type
TCEToolItem = class(TCollectionItem)
private
fProcess: TAsyncProcess;
fExecutable: string;
fWorkingDir: string;
fShowWin: TShowWindowOptions;
@ -18,6 +20,7 @@ type
fParameters: TStringList;
fToolAlias: string;
fShortcut: string;
fLogMessager: TCELogMessageSubject;
procedure setParameters(const aValue: TStringList);
published
property toolAlias: string read fToolAlias write fToolAlias;
@ -59,11 +62,14 @@ begin
inherited;
fToolAlias := format('<tool %d>', [ID]);
fParameters := TStringList.create;
fLogMessager := TCELogMessageSubject.create;
end;
destructor TCEToolItem.destroy;
begin
fParameters.Free;
fLogMessager.Free;
killProcess(fProcess);
inherited;
end;
@ -75,25 +81,22 @@ end;
procedure TCEToolItem.execute;
var
i: Integer;
proc: TProcess;
begin
proc := TProcess.Create(nil);
try
proc.Options := fOpts;
if fExecutable <> '' then
proc.Executable := CEMainForm.expandSymbolicString(fExecutable);
proc.ShowWindow := fShowWin;
if fWorkingDir <> '' then
proc.CurrentDirectory := CEMainForm.expandSymbolicString(fWorkingDir);
proc.Parameters.Clear;
for i:= 0 to fParameters.Count-1 do
if fParameters.Strings[i] <> '' then
proc.Parameters.AddText(CEMainForm.expandSymbolicString(fParameters.Strings[i]));
proc.Options := proc.Options - [poUsePipes, poWaitOnExit];
proc.Execute;
finally
proc.Free;
end;
killProcess(fProcess);
fProcess := TAsyncProcess.Create(nil);
//
fProcess.Options := fOpts;
if fExecutable <> '' then
fProcess.Executable := CEMainForm.expandSymbolicString(fExecutable);
fProcess.ShowWindow := fShowWin;
if fWorkingDir <> '' then
fProcess.CurrentDirectory := CEMainForm.expandSymbolicString(fWorkingDir);
fProcess.Parameters.Clear;
for i:= 0 to fParameters.Count-1 do
if fParameters.Strings[i] <> '' then
fProcess.Parameters.AddText(CEMainForm.expandSymbolicString(fParameters.Strings[i]));
subjLmProcess(fLogMessager, fProcess, nil, amcTool, amkBub);
fProcess.Execute;
end;
constructor TCETools.create(aOwner: TComponent);

12
src/ce_editor.pas
View File

@ -248,7 +248,7 @@ end;
procedure TCEEditorWidget.removeEditor(const aIndex: NativeInt);
begin
CEMainForm.MessageWidget.ClearMessages(mcEditor);
//CEMainForm.MessageWidget.ClearMessages(mcEditor);
editor[aIndex].OnChange:= nil;
pageControl.Pages[aIndex].Free;
end;
@ -399,11 +399,11 @@ begin
fKeyChanged := false;
if fDoc.Lines.Count = 0 then exit;
//
if fProj = nil then
CEMainForm.MessageWidget.ClearMessages(mcEditor)
else begin
//if fProj = nil then
//CEMainForm.MessageWidget.ClearMessages(mcEditor)
//else begin
// if the source is in proj then we want to keep messages to correct mistakes.
end;
//end;
lex(fDoc.Lines.Text, tokLst);
@ -428,7 +428,7 @@ begin
if md = '' then md := extractFileName(fDoc.fileName);
pageControl.ActivePage.Caption := md;
CEMainForm.MessageWidget.scrollToBack;
//CEMainForm.MessageWidget.scrollToBack;
tokLst.Clear;
errLst.Clear;
end;

84
src/ce_interfaces.pas
View File

@ -5,7 +5,8 @@ unit ce_interfaces;
interface
uses
Classes, SysUtils, actnList, menus, ce_synmemo, ce_project, ce_observer;
Classes, SysUtils, actnList, process, menus,
ce_synmemo, ce_project, ce_observer;
type
@ -137,6 +138,30 @@ type
end;
/// describes the message kind, when Auto implies that a ICELogMessageObserver guess the kind.
TCEAppMessageKind = (amkAuto, amkBub, amkInf, amkWarn, amkErr);
/// describes the message context. Used by a ICELogMessageObserver to filter the messages.
TCEAppMessageCtxt = (amcApp, amcTool, amcProj, amcEdit);
(**
* An implementer get some log messages.
*)
ICELogMessageObserver = interface
['ICEMessage']
// a TCELogMessageSubject sends a message based on a string.
procedure lmStandard(const aValue: string; aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
// a TCELogMessageSubject sends a message based on a process output.
procedure lmProcess(const aValue: TProcess; aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
end;
(**
* An implementer sends some log messages.
*)
TCELogMessageSubject = class(TCECustomSubject)
protected
function acceptObserver(aObject: TObject): boolean; override;
end;
{
subject Primitives:
@ -147,27 +172,34 @@ type
(**
* TCEMultiDocSubject primitives.
*)
procedure subjDocNew(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjDocClosing(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjDocFocused(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjDocChanged(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjDocNew(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjDocClosing(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjDocFocused(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjDocChanged(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo); {$IFDEF RELEASE}inline;{$ENDIF}
(**
* TCEProjectSubject primitives.
*)
procedure subjProjNew(aSubject: TCEProjectSubject; aProj: TCEProject); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjProjClosing(aSubject: TCEProjectSubject; aProj: TCEProject); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjProjFocused(aSubject: TCEProjectSubject; aProj: TCEProject); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjProjChanged(aSubject: TCEProjectSubject; aProj: TCEProject); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjProjNew(aSubject: TCEProjectSubject; aProj: TCEProject); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjProjClosing(aSubject: TCEProjectSubject; aProj: TCEProject); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjProjFocused(aSubject: TCEProjectSubject; aProj: TCEProject); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjProjChanged(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}
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}
(**
* TCELogMessageSubject primitives.
*)
procedure subjLmStandard(aSubject: TCELogMessageSubject; const aValue: string;
aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
procedure subjLmProcess(aSubject: TCELogMessageSubject; const aValue: TProcess;
aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
implementation
@ -280,7 +312,7 @@ begin
end;
{$ENDREGION}
{$REGION TCEEditableShortCutSubject}
{$REGION TCEMainMenuSubject}
function TCEMainMenuSubject.acceptObserver(aObject: TObject): boolean;
begin
exit(aObject is ICEMainMenuProvider);
@ -292,5 +324,31 @@ function TCEEditableShortCutSubject.acceptObserver(aObject: TObject): boolean;
begin
exit(aObject is ICEEditableShortCut);
end;
{$ENDREGION}
{$REGION TCELogMessageSubject}
function TCELogMessageSubject.acceptObserver(aObject: TObject): boolean;
begin
exit(aObject is ICELogMessageObserver);
end;
procedure subjLmStandard(aSubject: TCELogMessageSubject; const aValue: string;
aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICELogMessageObserver).lmStandard(aValue, aData, aCtxt, aKind);
end;
procedure subjLmProcess(aSubject: TCELogMessageSubject; const aValue: TProcess;
aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICELogMessageObserver).lmProcess(aValue, aData, aCtxt, aKind);
end;
{$ENDREGION}
end.

33
src/ce_main.pas
View File

@ -197,6 +197,8 @@ type
fRunProc: TAsyncProcess;
fLogMessager: TCELogMessageSubject;
// ICEMultiDocObserver
procedure docNew(const aDoc: TCESynMemo);
procedure docClosing(const aDoc: TCESynMemo);
@ -280,7 +282,7 @@ type
function expandSymbolicString(const symString: string): string;
//
property WidgetList: TCEWidgetList read fWidgList;
property MessageWidget: TCEMessagesWidget read fMesgWidg;
//property MessageWidget: TCEMessagesWidget read fMesgWidg;
property LibraryManager: TLibraryManager read fLibMan;
property CustomTools: TCETools read fTools;
end;
@ -300,6 +302,8 @@ uses
constructor TCEMainForm.create(aOwner: TComponent);
begin
inherited create(aOwner);
fLogMessager := TCELogMessageSubject.create;
//
EntitiesConnector.addObserver(self);
//
InitMRUs;
@ -590,7 +594,10 @@ begin
if WindowState = wsMinimized then
WindowState := wsNormal;
for i:= 0 to fWidgList.Count-1 do
begin
DockMaster.GetAnchorSite(fWidgList.widget[i]).Show;
DockMaster.GetAnchorSite(fWidgList.widget[i]).WindowState := wsNormal;
end;
if not Visible then exit;
//
forceDirectory(getDocPath);
@ -688,9 +695,7 @@ begin
exit;
//
fname := fRunProc.Executable;
fRunProc.Terminate(0);
fRunProc.Free;
fRunProc := nil;
killProcess(fRunProc);
if fileExists(fname) then
sysutils.DeleteFile(fname);
end;
@ -707,6 +712,7 @@ begin
fProject.Free;
FreeRunnableProc;
//
fLogMessager.Free;
EntitiesConnector.removeObserver(self);
inherited;
end;
@ -1622,7 +1628,10 @@ var
begin
// TODO-cbugfix: possible loading AV, xml saved after undocking some widgets, xml file abnormal size.
for i:= 0 to fWidgList.Count-1 do
begin
DockMaster.GetAnchorSite(fWidgList.widget[i]).Show;
DockMaster.GetAnchorSite(fWidgList.widget[i]).WindowState := wsNormal;
end;
//
forceDirectory(extractFilePath(aFilename));
xcfg := TXMLConfigStorage.Create(aFilename, false);
@ -2012,24 +2021,24 @@ begin
ctxt := opCode and $0F000000;
oper := opCode and $000FFFFF;
{
case ctxt of
CTXT_MSGS:
case oper of
DT_ERR: CEMainForm.MessageWidget.addCeErr(PChar(data1));
DT_INF: CEMainForm.MessageWidget.addCeInf(PChar(data1));
DT_WARN: CEMainForm.MessageWidget.addCeWarn(PChar(data1));
else CEMainForm.MessageWidget.addCeWarn('unsupported dispatcher opCode');
//DT_ERR: CEMainForm.MessageWidget.addCeErr(PChar(data1));
//DT_INF: CEMainForm.MessageWidget.addCeInf(PChar(data1));
//DT_WARN: CEMainForm.MessageWidget.addCeWarn(PChar(data1));
//else CEMainForm.MessageWidget.addCeWarn('unsupported dispatcher opCode');
end;
CTXT_DLGS:
case oper of
DT_ERR: dlgOkError(PChar(data1));
DT_INF: dlgOkInfo(PChar(data1));
DT_WARN: dlgOkInfo(PChar(data1));
else CEMainForm.MessageWidget.addCeWarn('unsupported dispatcher opCode');
//else CEMainForm.MessageWidget.addCeWarn('unsupported dispatcher opCode');
end;
else CEMainForm.MessageWidget.addCeWarn('unsupported dispatcher opCode');
end;
//else CEMainForm.MessageWidget.addCeWarn('unsupported dispatcher opCode');
end;}
end;

79
src/ce_messages.pas
View File

@ -6,8 +6,8 @@ interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls,
lcltype, ce_widget, ActnList, Menus, clipbrd, AnchorDocking, ce_project,
ce_synmemo, ce_dlangutils, ce_interfaces, ce_observer;
lcltype, ce_widget, ActnList, Menus, clipbrd, AnchorDocking, process, asyncprocess,
ce_common, ce_project, ce_synmemo, ce_dlangutils, ce_interfaces, ce_observer;
type
@ -21,7 +21,7 @@ type
position: TPoint;
end;
TCEMessagesWidget = class(TCEWidget, ICEMultiDocObserver, ICEProjectObserver)
TCEMessagesWidget = class(TCEWidget, ICEMultiDocObserver, ICEProjectObserver, ICELogMessageObserver)
imgList: TImageList;
List: TTreeView;
procedure ListDblClick(Sender: TObject);
@ -45,6 +45,9 @@ type
procedure setMaxMessageCount(aValue: Integer);
procedure listDeletion(Sender: TObject; Node: TTreeNode);
function newMessageItemData(aCtxt: TMessageContext): PMessageItemData;
procedure processOutput(Sender: TObject);
procedure processTerminate(Sender: TObject);
procedure logProcessOutput(const aProcess: TProcess);
//
procedure optset_MaxMessageCount(aReader: TReader);
procedure optget_MaxMessageCount(awriter: TWriter);
@ -57,6 +60,7 @@ type
procedure scrollToBack;
procedure addMessage(const aMsg: string; aCtxt: TMessageContext = mcUnknown);
procedure addMessage(const aMsg: string; const aData: PMessageItemData);
procedure addCeBub(const aMsg: string; aCtxt: TMessageContext = mcUnknown);
procedure addCeInf(const aMsg: string; aCtxt: TMessageContext = mcUnknown);
procedure addCeErr(const aMsg: string; aCtxt: TMessageContext = mcUnknown);
procedure addCeWarn(const aMsg: string; aCtxt: TMessageContext = mcUnknown);
@ -77,6 +81,11 @@ type
procedure docFocused(const aDoc: TCESynMemo);
procedure docChanged(const aDoc: TCESynMemo);
//
procedure lmStandard(const aValue: string; aData: Pointer;
aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
procedure lmProcess(const aValue: TProcess; aData: Pointer;
aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
//
procedure ClearAllMessages;
procedure ClearMessages(aCtxt: TMessageContext);
end;
@ -309,6 +318,58 @@ begin
end;
{$ENDREGION}
{$REGION ICELogMessageObserver ---------------------------------------------------}
procedure TCEMessagesWidget.lmStandard(const aValue: string; aData: Pointer;
aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
begin
case aKInd of
amkBub: addCeBub(aValue);
amkInf: addCeInf(aValue);
amkWarn:addCeWarn(aValue);
amkErr: addCeErr(aValue);
end;
end;
procedure TCEMessagesWidget.lmProcess(const aValue: TProcess; aData: Pointer;
aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
begin
if not (poUsePipes in aValue.Options) then
exit;
//
if aValue is TAsyncProcess then begin
TAsyncProcess(aValue).OnReadData := @processOutput;
TAsyncProcess(aValue).OnTerminate := @processTerminate;
end else
logProcessOutput(aValue);
end;
procedure TCEMessagesWidget.processOutput(Sender: TObject);
begin
logProcessOutput(TProcess(Sender));
end;
procedure TCEMessagesWidget.processTerminate(Sender: TObject);
begin
logProcessOutput(TProcess(Sender));
end;
procedure TCEMessagesWidget.logProcessOutput(const aProcess: TProcess);
var
lst: TStringList;
str: string;
begin
lst := TStringList.Create;
try
processOutputToStrings(aProcess, lst);
for str in lst do
addCeBub(str);
finally
lst.Free;
end;
end;
{$ENDREGION}
{$REGION Messages --------------------------------------------------------------}
procedure TCEMessagesWidget.clearOutOfRangeMessg;
begin
@ -395,6 +456,18 @@ begin
end;
end;
procedure TCEMessagesWidget.addCeBub(const aMsg: string; aCtxt: TMessageContext = mcUnknown);
var
item: TTreeNode;
begin
item := List.Items.Add(nil, 'Coedit message: ' + aMsg);
item.Data := newMessageItemData(aCtxt);
item.ImageIndex := 0;
item.SelectedIndex := 0;
clearOutOfRangeMessg;
scrollToBack;
end;
procedure TCEMessagesWidget.addCeInf(const aMsg: string; aCtxt: TMessageContext = mcUnknown);
var
item: TTreeNode;

11
src/ce_miniexplorer.pas
View File

@ -6,7 +6,8 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Menus, ComCtrls, Buttons, lcltype, strutils, ce_widget, ce_common;
Menus, ComCtrls, Buttons, lcltype, strutils, ce_widget, ce_common,
ce_interfaces, ce_observer;
type
TCEMiniExplorerWidget = class(TCEWidget)
@ -31,6 +32,7 @@ type
private
fFavorites: TStringList;
fLastFold: string;
fLogMessager: TCELogMessageSubject;
procedure lstFavDblClick(Sender: TObject);
procedure optset_LastFold(aReader: TReader);
procedure optget_LastFold(aWriter: TWriter);
@ -69,6 +71,7 @@ uses
constructor TCEMiniExplorerWidget.create(aIwner: TComponent);
begin
inherited;
fLogMessager := TCELogMessageSubject.create;
fFavorites := TStringList.Create;
fFavorites.onChange := @favStringsChange;
lstFiles.OnDeletion := @lstDeletion;
@ -87,6 +90,7 @@ end;
destructor TCEMiniExplorerWidget.destroy;
begin
fLogMessager.Free;
fFavorites.Free;
inherited;
end;
@ -253,8 +257,9 @@ begin
if lstFiles.Selected.Data = nil then exit;
fname := PString(lstFiles.Selected.Data)^;
if not fileExists(fname) then exit;
if not shellOpen(fname) then CEMainForm.MessageWidget.addCeErr
(format('the shell failed to open "%s"', [shortenPath(fname, 25)]));
if not shellOpen(fname) then subjLmStandard(fLogMessager,
(format('the shell failed to open "%s"', [shortenPath(fname, 25)])),
nil, amcTool, amkErr);
end;
{$ENDREGION}

3
src/ce_observer.pas
View File

@ -44,7 +44,8 @@ type
end;
(**
* Standard implementation of an ICESubject
* Standard implementation of an ICESubject.
* Any descendant adds itself to the global EntitiesConnector.
*)
TCECustomSubject = class(ICESubject)
protected

85
src/ce_project.pas
View File

@ -8,8 +8,8 @@ uses
{$IFDEF DEBUG}
LclProc,
{$ENDIF}
Classes, SysUtils, ce_common, ce_writableComponent ,ce_dmdwrap, ce_libman,
ce_observer;
Classes, SysUtils, process, asyncprocess, ce_common, ce_writableComponent,
ce_dmdwrap, ce_libman, ce_observer;
type
@ -34,6 +34,8 @@ type
fLibMan: TLibraryManager;
fChangedCount: NativeInt;
fProjectSubject: TCECustomSubject;
fRunner: TAsyncProcess;
fLogMessager: TCECustomSubject;
procedure doChanged;
procedure setLibAliases(const aValue: TStringList);
procedure subMemberChanged(sender : TObject);
@ -43,6 +45,7 @@ type
procedure setConfIx(aValue: Integer);
function getConfig(const ix: integer): TCompilerConfiguration;
function getCurrConf: TCompilerConfiguration;
procedure runPrePostProcess(const processInfo: TCompileProcOptions);
protected
procedure afterSave; override;
procedure afterLoad; override;
@ -68,6 +71,8 @@ type
function addConfiguration: TCompilerConfiguration;
procedure getOpts(const aList: TStrings);
function outputFilename: string;
procedure runProject;
procedure compileProject;
//
property libraryManager: TLibraryManager read fLibMan write fLibMan;
property configuration[ix: integer]: TCompilerConfiguration read getConfig;
@ -79,11 +84,12 @@ type
implementation
uses
ce_interfaces, controls, dialogs;
ce_interfaces, controls, dialogs, ce_main;
constructor TCEProject.create(aOwner: TComponent);
begin
inherited create(aOwner);
fLogMessager := TCELogMessageSubject.create;
fProjectSubject := TCEProjectSubject.create;
//
fLibAliases := TStringList.Create;
@ -103,6 +109,7 @@ destructor TCEProject.destroy;
begin
subjProjClosing(TCEProjectSubject(fProjectSubject), self);
fProjectSubject.Free;
fLogMessager.Free;
//
fOnChange := nil;
fLibAliases.Free;
@ -431,6 +438,78 @@ begin
end;
end;
procedure TCEProject.runPrePostProcess(const processInfo: TCompileProcOptions);
var
process: TProcess;
pname: string;
i, j: integer;
begin
with currentConfiguration do
begin
pname := CEMainForm.expandSymbolicString(preBuildProcess.executable);
if pname <> '``' then
if exeInSysPath(pname) then
begin
process := TProcess.Create(nil);
try
processInfo.setProcess(process);
process.Executable := pname;
j := process.Parameters.Count-1;
for i:= 0 to j do
process.Parameters.AddText(CEMainForm.expandSymbolicString(process.Parameters.Strings[i]));
for i:= 0 to j do
process.Parameters.Delete(0);
if process.CurrentDirectory = '' then
process.CurrentDirectory := extractFilePath(process.Executable);
process.Execute;
if not (poWaitOnExit in process.Options) then
if poUsePipes in process.Options then
subjLmProcess(TCELogMessageSubject(fLogMessager), process, @Self, amcProj, amkBub);
finally
process.Free;
end;
end
else subjLmStandard(TCELogMessageSubject(fLogMessager),
'the pre/post compilation executable does not exist', @Self, amcProj, amkBub);
end;
end;
procedure TCEProject.runProject;
begin
killProcess(fRunner);
fRunner := TAsyncProcess.Create(nil);
end;
procedure TCEProject.compileProject;
var
compilproc: TProcess;
olddir: string;
begin
runPrePostProcess(currentConfiguration.preBuildProcess);
compilproc := TProcess.Create(nil);
getDir(0, olddir);
try
compilproc.Executable := DCompiler;
compilproc.Options := compilproc.Options + [poStderrToOutPut, poUsePipes];
compilproc.ShowWindow := swoHIDE;
getOpts(compilproc.Parameters);
compilproc.Execute;
subjLmProcess(TCELogMessageSubject(fLogMessager), compilproc, @Self, amcProj, amkBub);
if compilproc.ExitStatus <> 0 then
else ;
runPrePostProcess(currentConfiguration.postBuildProcess);
finally
compilproc.Free;
chDir(olddir);
end;
end;
initialization
RegisterClasses([TCEProject]);
end.

6
src/ce_staticexplorer.pas
View File

@ -24,6 +24,7 @@ type
procedure TreeFilterEdit1AfterFilter(Sender: TObject);
procedure TreeKeyPress(Sender: TObject; var Key: char);
private
fLogMessager: TCELogMessageSubject;
fActRefresh: TAction;
fActRefreshOnChange: TAction;
fActRefreshOnFocus: TAction;
@ -85,6 +86,7 @@ uses ce_main, ce_libman;
{$REGION Standard Comp/Obj------------------------------------------------------}
constructor TCEStaticExplorerWidget.create(aOwner: TComponent);
begin
fLogMessager := TCELogMessageSubject.create;
fAutoRefresh := false;
fRefreshOnFocus := true;
fRefreshOnChange := false;
@ -132,6 +134,8 @@ end;
destructor TCEStaticExplorerWidget.destroy;
begin
EntitiesConnector.removeObserver(self);
//
fLogMessager.Free;
inherited;
end;
{$ENDREGION}
@ -479,7 +483,7 @@ begin
'struct' :ndCat := Tree.Items.AddChildObject(ndStruct, nme, ln);
'template' :ndCat := Tree.Items.AddChildObject(ndTmp, nme, ln);
'variable' :ndCat := Tree.Items.AddChildObject(ndVar, nme, ln);
else CEMainForm.MessageWidget.addCeWarn('static explorer does not handle this kind: ' + knd);
else subjLmStandard(fLogMessager, 'static explorer does not handle this kind: ' + knd, nil, amcApp, amkWarn);
end;
if ndCat = nil then