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

Merge branch 'a12_2_a13'

This commit is contained in:
Basile Burg 2015-02-14 02:22:20 +01:00
parent 18f7237236 9df88278a0
commit 32e1042006
11 changed files with 192 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
src/ce_interfaces.pas
View File

@ -5,16 +5,17 @@ unit ce_interfaces;
interface
uses
Classes, SysUtils, actnList, menus,
Classes, SysUtils, actnList, menus, process,
ce_synmemo, ce_project, ce_observer;
type
(**
* An implementer can save and load some stuffs on application start/quit
*)
ICESessionOptionsObserver = interface
['ICEWidgetPersist']
['ICESessionOptionsObserver']
// persistent things are about to be saved.
procedure sesoptBeforeSave;
// persistent things can be declared to aFiler.
@ -147,24 +148,28 @@ type
TCEAppMessageCtxt = (amcAll, amcEdit, amcProj, amcApp, amcMisc);
(**
* An implementer gets some log messages.
* AData: either an editor or a project, according to aCtxt.
* Single service given by the messages widget.
* Client can retrieve the service instance in the EntityConnector.
*)
ICELogMessageObserver = interface
['ICEMessage']
// a TCELogMessageSubject sends a message based on a string.
procedure lmFromString(const aValue: string; aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
// a TCELogMessageSubject sends a clearing request based on a context.
procedure lmClearByContext(aCtxt: TCEAppMessageCtxt);
// a TCELogMessageSubject sends a clearing request based on a data.
procedure lmClearByData(aData: Pointer);
ICEMessagesDisplay = interface(ICESingleService)
// display a message
procedure message(const aValue: string; aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
// clear the messages related to the context aCtxt.
procedure clearByContext(aCtxt: TCEAppMessageCtxt);
// clear the messages related to the data aData.
procedure clearByData(aData: Pointer);
end;
(**
* An implementer sends some log messages.
* Single service given by the process-input widget.
* Client can retrieve the service instance in the EntityConnector.
*)
TCELogMessageSubject = class(TCECustomSubject)
protected
function acceptObserver(aObject: TObject): boolean; override;
ICEProcInputHandler = interface(ICESingleService)
// add an entry to the list of process which can receive an user input
procedure addProcess(aProcess: TProcess);
// remove an entry
procedure removeProcess(aProcess: TProcess);
end;
@ -198,13 +203,17 @@ type
procedure subjSesOptsDeclareProperties(aSubject: TCESessionOptionsSubject; aFiler: TFiler);{$IFDEF RELEASE}inline;{$ENDIF}
procedure subjSesOptsAfterLoad(aSubject: TCESessionOptionsSubject); {$IFDEF RELEASE}inline;{$ENDIF}
(**
* TCELogMessageSubject primitives.
*)
procedure subjLmFromString(aSubject: TCELogMessageSubject; const aValue: string;
aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjLmClearByContext(aSubject: TCELogMessageSubject; aCtxt: TCEAppMessageCtxt); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjLmClearByData(aSubject: TCELogMessageSubject; aData: Pointer); {$IFDEF RELEASE}inline;{$ENDIF}
{
Services assignements:
lazily get the interface of a service when needed or for a ponctual usage
}
function getMessageDisplay(var obj: ICEMessagesDisplay): ICEMessagesDisplay; overload;
function getMessageDisplay: ICEMessagesDisplay;overload;
function getprocInputHandler(var obj: ICEProcInputHandler): ICEProcInputHandler;overload;
function getprocInputHandler: ICEProcInputHandler;overload;
implementation
@ -339,38 +348,29 @@ begin
end;
{$ENDREGION}
{$REGION TCELogMessageSubject --------------------------------------------------}
function TCELogMessageSubject.acceptObserver(aObject: TObject): boolean;
function getMessageDisplay(var obj: ICEMessagesDisplay): ICEMessagesDisplay;
begin
exit(aObject is ICELogMessageObserver);
if obj = nil then
obj := EntitiesConnector.getSingleService('ICEMessagesDisplay') as ICEMessagesDisplay;
exit(obj);
end;
procedure subjLmFromString(aSubject: TCELogMessageSubject; const aValue: string;
aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
var
i: Integer;
function getMessageDisplay: ICEMessagesDisplay;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICELogMessageObserver).lmFromString(aValue, aData, aCtxt, aKind);
exit(EntitiesConnector.getSingleService('ICEMessagesDisplay') as ICEMessagesDisplay);
end;
procedure subjLmClearByContext(aSubject: TCELogMessageSubject; aCtxt: TCEAppMessageCtxt);
var
i: Integer;
function getprocInputHandler(var obj: ICEProcInputHandler): ICEProcInputHandler;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICELogMessageObserver).lmClearByContext(aCtxt);
if obj = nil then
obj := EntitiesConnector.getSingleService('ICEProcInputHandler') as ICEProcInputHandler;
exit(obj);
end;
procedure subjLmClearByData(aSubject: TCELogMessageSubject; aData: Pointer);
var
i: Integer;
function getprocInputHandler: ICEProcInputHandler;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICELogMessageObserver).lmClearByData(aData);
exit(EntitiesConnector.getSingleService('ICEProcInputHandler') as ICEProcInputHandler);
end;
{$ENDREGION}
end.

37
src/ce_main.pas
View File

@ -203,7 +203,7 @@ type
fInitialized: boolean;
fRunnableSw: string;
fRunProc: TCheckedAsyncProcess;
fLogMessager: TCELogMessageSubject;
fMsgs: ICEMessagesDisplay;
fMainMenuSubj: TCEMainMenuSubject;
procedure updateMainMenuProviders;
@ -298,7 +298,6 @@ uses
constructor TCEMainForm.create(aOwner: TComponent);
begin
inherited create(aOwner);
fLogMessager := TCELogMessageSubject.create;
fMainMenuSubj:= TCEMainMenuSubject.create;
//
EntitiesConnector.addObserver(self);
@ -414,6 +413,8 @@ begin
fTodolWidg:= TCETodoListWidget.create(self);
//fResWidg := TCEResmanWidget.create(self);
getMessageDisplay(fMsgs);
{$IFDEF WIN32}
fCdbWidg := TCECdbWidget.create(self);
{$ENDIF}
@ -639,7 +640,6 @@ begin
fProject.Free;
FreeRunnableProc;
//
fLogMessager.Free;
fMainMenuSubj.Free;
EntitiesConnector.removeObserver(self);
inherited;
@ -656,7 +656,7 @@ begin
if fMesgWidg = nil then
ce_common.dlgOkError(E.Message)
else
fMesgWidg.lmFromString(E.Message, nil, amcApp, amkErr);
fMsgs.message(E.Message, nil, amcApp, amkErr);
end;
procedure TCEMainForm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
@ -1203,10 +1203,10 @@ begin
try
processOutputToStrings(proc, lst);
if proc = fRunProc then for str in lst do
subjLmFromString(fLogMessager, str, fDoc, amcEdit, amkBub)
fMsgs.message(str, fDoc, amcEdit, amkBub)
else if proc.Executable = DCompiler then
for str in lst do
subjLmFromString(fLogMessager, str, fDoc, amcEdit, amkAuto);
fMsgs.message(str, fDoc, amcEdit, amkAuto);
finally
lst.Free;
end;
@ -1217,6 +1217,7 @@ var
proc: TProcess;
lst: TStringList;
str: string;
inph: TObject;
begin
proc := TProcess(sender);
lst := TStringList.Create;
@ -1226,13 +1227,16 @@ begin
if proc = fRunProc then
begin
for str in lst do
subjLmFromString(fLogMessager, str, fDoc, amcEdit, amkBub);
fMsgs.message(str, fDoc, amcEdit, amkBub);
end;
finally
lst.Free;
end;
if proc = fPrInpWidg.process then
fPrInpWidg.process := nil;
//if proc = fPrInpWidg.process then
//fPrInpWidg.process := nil;
inph := EntitiesConnector.getSingleService('ICEProcInputHandler');
if (inph <> nil) then (inph as ICEProcInputHandler).removeProcess(proc);
end;
procedure TCEMainForm.compileAndRunFile(unittest: boolean; const runArgs: string = '');
@ -1253,9 +1257,8 @@ begin
dmdproc := TProcess.Create(nil);
try
subjLmClearByData(fLogMessager, fDoc);
subjLmFromString(fLogMessager, 'compiling ' + shortenPath(fDoc.fileName, 25),
fDoc, amcEdit, amkInf);
fMsgs.clearByData(fDoc);
fMsgs.message('compiling ' + shortenPath(fDoc.fileName, 25), fDoc, amcEdit, amkInf);
if fileExists(fDoc.fileName) then fDoc.save
else fDoc.saveTempFile;
@ -1284,20 +1287,20 @@ begin
if (dmdProc.ExitStatus = 0) then
begin
subjLmFromString(fLogMessager, shortenPath(fDoc.fileName, 25)
+ ' successfully compiled', fDoc, amcEdit, amkInf);
fMsgs.message(shortenPath(fDoc.fileName, 25) + ' successfully compiled',
fDoc, amcEdit, amkInf);
fRunProc.CurrentDirectory := extractFilePath(fRunProc.Executable);
if runArgs <> '' then
fRunProc.Parameters.DelimitedText := symbolExpander.get(runArgs);
fRunProc.Executable := fname + exeExt;
fPrInpWidg.process := fRunProc;
getprocInputHandler.addProcess(fRunProc);
fRunProc.Execute;
sysutils.DeleteFile(fname + objExt);
end
else begin
subjLmFromString(fLogMessager, shortenPath(fDoc.fileName,25)
+ ' has not been compiled', fDoc, amcEdit, amkErr);
fMsgs.message(shortenPath(fDoc.fileName,25) + ' has not been compiled',
fDoc, amcEdit, amkErr);
end;
finally

40
src/ce_messages.pas
View File

@ -21,7 +21,7 @@ type
end;
{ TCEMessagesWidget }
TCEMessagesWidget = class(TCEWidget, ICEMultiDocObserver, ICEProjectObserver, ICELogMessageObserver)
TCEMessagesWidget = class(TCEWidget, ICEMultiDocObserver, ICEProjectObserver, ICEMessagesDisplay)
btnClearCat: TBitBtn;
imgList: TImageList;
List: TTreeView;
@ -79,6 +79,11 @@ type
procedure docClosing(aDoc: TCESynMemo);
procedure docFocused(aDoc: TCESynMemo);
procedure docChanged(aDoc: TCESynMemo);
//
function singleServiceName: string;
procedure message(const aValue: string; aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
procedure clearbyContext(aCtxt: TCEAppMessageCtxt);
procedure clearbyData(aData: Pointer);
protected
procedure sesoptDeclareProperties(aFiler: TFiler); override;
//
@ -92,10 +97,7 @@ type
destructor destroy; override;
//
procedure scrollToBack;
//
procedure lmFromString(const aValue: string; aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
procedure lmClearbyContext(aCtxt: TCEAppMessageCtxt);
procedure lmClearbyData(aData: Pointer);
end;
function guessMessageKind(const aMessg: string): TCEAppMessageKind;
@ -153,6 +155,7 @@ begin
btnClearCat.OnClick := @actClearCurCatExecute;
//
EntitiesConnector.addObserver(self);
EntitiesConnector.addSingleService(self);
end;
destructor TCEMessagesWidget.destroy;
@ -180,7 +183,7 @@ begin
if List.Items[i].MultiSelected then
List.Items.Delete(List.Items[i]);
end
else lmClearbyContext(amcAll);
else clearbyContext(amcAll);
end;
end;
@ -285,18 +288,18 @@ end;
procedure TCEMessagesWidget.actClearAllExecute(Sender: TObject);
begin
lmClearbyContext(amcAll);
clearbyContext(amcAll);
end;
procedure TCEMessagesWidget.actClearCurCatExecute(Sender: TObject);
begin
case fCtxt of
amcAll, amcApp, amcMisc :
lmClearbyContext(fCtxt);
clearbyContext(fCtxt);
amcEdit: if fDoc <> nil then
lmClearbyData(fDoc);
clearbyData(fDoc);
amcProj: if fProj <> nil then
lmClearbyData(fProj);
clearbyData(fProj);
end;
end;
@ -357,7 +360,7 @@ begin
if fProj <> aProject then
exit;
//
lmClearByData(aProject);
clearbyData(aProject);
fProj := nil;
filterMessages(fCtxt);
end;
@ -388,7 +391,7 @@ end;
procedure TCEMessagesWidget.docClosing(aDoc: TCESynMemo);
begin
if aDoc <> fDoc then exit;
lmClearbyData(fDoc);
clearbyData(fDoc);
fDoc := nil;
filterMessages(fCtxt);
end;
@ -406,8 +409,13 @@ begin
end;
{$ENDREGION}
{$REGION ICELogMessageObserver -------------------------------------------------}
procedure TCEMessagesWidget.lmFromString(const aValue: string; aData: Pointer;
{$REGION ICEMessagesDisplay ----------------------------------------------------}
function TCEMessagesWidget.singleServiceName: string;
begin
exit('ICEMessagesDisplay');
end;
procedure TCEMessagesWidget.message(const aValue: string; aData: Pointer;
aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
var
dt: PMessageData;
@ -430,7 +438,7 @@ begin
filterMessages(fCtxt);
end;
procedure TCEMessagesWidget.lmClearByContext(aCtxt: TCEAppMessageCtxt);
procedure TCEMessagesWidget.clearByContext(aCtxt: TCEAppMessageCtxt);
var
i: Integer;
msgdt: PMessageData;
@ -448,7 +456,7 @@ begin
end;
end;
procedure TCEMessagesWidget.lmClearByData(aData: Pointer);
procedure TCEMessagesWidget.clearByData(aData: Pointer);
var
i: Integer;
msgdt: PMessageData;

5
src/ce_miniexplorer.pas
View File

@ -36,7 +36,6 @@ type
private
fFavorites: TStringList;
fLastFold: string;
fLogMessager: TCELogMessageSubject;
procedure lstFavDblClick(Sender: TObject);
procedure optset_LastFold(aReader: TReader);
procedure optget_LastFold(aWriter: TWriter);
@ -97,7 +96,6 @@ begin
png.Free;
end;
//
fLogMessager := TCELogMessageSubject.create;
fFavorites := TStringList.Create;
fFavorites.onChange := @favStringsChange;
lstFiles.OnDeletion := @lstDeletion;
@ -122,7 +120,6 @@ end;
destructor TCEMiniExplorerWidget.destroy;
begin
fLogMessager.Free;
fFavorites.Free;
inherited;
end;
@ -320,7 +317,7 @@ begin
if lstFiles.Selected.Data = nil then exit;
fname := PString(lstFiles.Selected.Data)^;
if not fileExists(fname) then exit;
if not shellOpen(fname) then subjLmFromString(fLogMessager,
if not shellOpen(fname) then getMessageDisplay.message(
(format('the shell failed to open "%s"', [shortenPath(fname, 25)])),
nil, amcMisc, amkErr);
end;

43
src/ce_observer.pas
View File

@ -9,6 +9,16 @@ uses
type
(**
* interface for a single Coedit service (many to one relation).
* A service is valid during the whole application life-time and
* is mostly designed to avoid messy uses clauses or to limit
* the visibility of the implementer methods.
*)
ICESingleService = interface
function singleServiceName: string;
end;
(**
* Manages the connections between the observers and their subjects in the whole program.
*)
@ -16,6 +26,7 @@ type
private
fObservers: TObjectList;
fSubjects: TObjectList;
fServices: TObjectList;
fUpdatesCount: Integer;
procedure tryUpdate;
procedure updateEntities;
@ -34,15 +45,20 @@ type
procedure addSubject(aSubject: TObject);
procedure removeObserver(anObserver: TObject);
procedure removeSubject(aSubject: TObject);
// allow to register a single service provider.
procedure addSingleService(aServiceProvider: TObject);
// allow to retrieve a single service provider based on its interface name
function getSingleService(const aName: string): TObject;
// should be tested before forceUpdate()
property isUpdating: boolean read getIsUpdating;
end;
(**
* Interface for a Coedit subject. Basically designed to hold a list of observer
*)
ICESubject = interface
['ICESubject']
// an observer is proposed. anObserver is not necessarly compatible.
procedure addObserver(anObserver: TObject);
// anObserver must be removed.
@ -87,6 +103,7 @@ constructor TCEEntitiesConnector.create;
begin
fObservers := TObjectList.create(false);
fSubjects := TObjectList.create(false);
fServices := TObjectList.create(false);
end;
destructor TCEEntitiesConnector.destroy;
@ -176,10 +193,34 @@ begin
end;
procedure TCEEntitiesConnector.removeSubject(aSubject: TObject);
begin
fSubjects.Remove(aSubject);
tryUpdate;
end;
procedure TCEEntitiesConnector.addSingleService(aServiceProvider: TObject);
begin
if fServices.IndexOf(aServiceProvider) <> -1 then
exit;
if not (aServiceProvider is ICESingleService) then
exit;
fServices.Add(aServiceProvider);
end;
function TCEEntitiesConnector.getSingleService(const aName: string): TObject;
var
i: Integer;
serv: ICESingleService;
begin
result := nil;
for i := 0 to fServices.Count-1 do
begin
serv := fServices[i] as ICESingleService;
if serv.singleServiceName = aName then
exit(fServices[i]);
end;
end;
{$ENDREGION}
{$REGION TCECustomSubject ------------------------------------------------------}

34
src/ce_procinput.pas
View File

@ -6,10 +6,10 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Menus, StdCtrls, ce_widget, process, ce_common;
Menus, StdCtrls, ce_widget, process, ce_common, ce_interfaces, ce_observer;
type
TCEProcInputWidget = class(TCEWidget)
TCEProcInputWidget = class(TCEWidget, ICEProcInputHandler)
btnSend: TButton;
txtInp: TEdit;
txtExeName: TStaticText;
@ -20,16 +20,18 @@ type
fMru: TMRUList;
fProc: TProcess;
procedure sendInput;
procedure setProc(const aValue: TProcess);
//
procedure optset_InputMru(aReader: TReader);
procedure optget_InputMru(aWriter: TWriter);
//
function singleServiceName: string;
procedure addProcess(aProcess: TProcess);
procedure removeProcess(aProcess: TProcess);
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
//
procedure sesoptDeclareProperties(aFiler: TFiler); override;
property process: TProcess read fProc write setProc;
end;
implementation
@ -44,6 +46,7 @@ begin
inherited;
fMru := TMRUList.Create;
fMru.maxCount := 25;
EntitiesConnector.addSingleService(self);
end;
destructor TCEProcInputWidget.destroy;
@ -71,8 +74,13 @@ begin
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION Process input things --------------------------------------------------}
procedure TCEProcInputWidget.setProc(const aValue: TProcess);
{$REGION ICEProcInputHandler ---------------------------------------------------}
function TCEProcInputWidget.singleServiceName: string;
begin
exit('ICEProcInputHandler');
end;
procedure TCEProcInputWidget.addProcess(aProcess: TProcess);
begin
// TODO-cfeature: process list, imply that each TCESynMemo must have its own runnable TProcess
// currently they share the CEMainForm.fRunProc variable.
@ -81,14 +89,22 @@ begin
txtExeName.Caption := 'no process';
fProc := nil;
if aValue = nil then
if aProcess = nil then
exit;
if not (poUsePipes in aValue.Options) then
if not (poUsePipes in aProcess.Options) then
exit;
fProc := aValue;
fProc := aProcess;
txtExeName.Caption := shortenPath(fProc.Executable);
end;
procedure TCEProcInputWidget.removeProcess(aProcess: TProcess);
begin
if fProc = aProcess then
addProcess(nil);
end;
{$ENDREGION}
{$REGION Process input things --------------------------------------------------}
procedure TCEProcInputWidget.sendInput;
var
inp: string;

49
src/ce_project.pas
View File

@ -34,7 +34,6 @@ type
fUpdateCount: NativeInt;
fProjectSubject: TCECustomSubject;
fRunner: TCheckedAsyncProcess;
fLogMessager: TCECustomSubject;
fOutputFilename: string;
fCanBeRun: boolean;
procedure updateOutFilename;
@ -92,13 +91,12 @@ type
implementation
uses
ce_interfaces, controls, dialogs, ce_symstring, ce_libman, ce_main, ce_dcd;
ce_interfaces, controls, dialogs, ce_symstring, ce_libman, ce_dcd;
constructor TCEProject.create(aOwner: TComponent);
begin
inherited create(aOwner);
//
fLogMessager := TCELogMessageSubject.create;
fProjectSubject := TCEProjectSubject.create;
//
fLibAliases := TStringList.Create;
@ -123,7 +121,6 @@ destructor TCEProject.destroy;
begin
subjProjClosing(TCEProjectSubject(fProjectSubject), self);
fProjectSubject.Free;
fLogMessager.Free;
//
fOnChange := nil;
fLibAliases.Free;
@ -611,22 +608,24 @@ var
compilproc: TProcess;
olddir, prjpath: string;
prjname: string;
msgs: ICEMessagesDisplay;
begin
result := false;
config := currentConfiguration;
msgs := getMessageDisplay;
if config = nil then
begin
subjLmFromString(TCELogMessageSubject(fLogMessager),
'unexpected project error: no active configuration', Self, amcProj, amkErr);
msgs.message('unexpected project error: no active configuration',
Self, amcProj, amkErr);
exit;
end;
//
subjLmClearByData(TCELogMessageSubject(fLogMessager), Self);
msgs.clearByData(Self);
subjProjCompiling(TCEProjectSubject(fProjectSubject), Self);
//
if not runPrePostProcess(config.preBuildProcess) then
subjLmFromString(TCELogMessageSubject(fLogMessager),
'project warning: the pre-compilation process has not been properly executed', Self, amcProj, amkWarn);
msgs.message('project warning: the pre-compilation process has not been properly executed',
Self, amcProj, amkWarn);
//
if Sources.Count = 0 then exit;
//
@ -635,8 +634,7 @@ begin
olddir := '';
getDir(0, olddir);
try
subjLmFromString(TCELogMessageSubject(fLogMessager),
'compiling ' + prjname, Self, amcProj, amkInf);
msgs.message('compiling ' + prjname, Self, amcProj, amkInf);
prjpath := extractFilePath(fileName);
if directoryExists(prjpath) then
begin
@ -651,16 +649,14 @@ begin
while compilProc.Running do
compProcOutput(compilproc);
if compilproc.ExitStatus = 0 then begin
subjLmFromString(TCELogMessageSubject(fLogMessager),
prjname + ' has been successfully compiled', Self, amcProj, amkInf);
msgs.message(prjname + ' has been successfully compiled', Self, amcProj, amkInf);
result := true;
end else
subjLmFromString(TCELogMessageSubject(fLogMessager),
prjname + ' has not been compiled', Self, amcProj, amkWarn);
msgs.message(prjname + ' has not been compiled', Self, amcProj, amkWarn);
if not runPrePostProcess(config.PostBuildProcess) then
subjLmFromString(TCELogMessageSubject(fLogMessager),
'project warning: the post-compilation process has not been properly executed', Self, amcProj, amkWarn);
msgs.message( 'project warning: the post-compilation process has not been properly executed',
Self, amcProj, amkWarn);
finally
updateOutFilename;
@ -694,8 +690,8 @@ begin
//
if not fileExists(outputFilename) then
begin
subjLmFromString(TCELogMessageSubject(fLogMessager),
'output executable missing: ' + shortenPath(outputFilename, 25), Self, amcProj, amkErr);
getMessageDisplay.message('output executable missing: ' + shortenPath(outputFilename, 25),
Self, amcProj, amkErr);
exit;
end;
//
@ -705,7 +701,7 @@ begin
if poUsePipes in fRunner.Options then begin
fRunner.OnReadData := @runProcOutput;
fRunner.OnTerminate := @runProcOutput;
CEMainForm.processInput.process := fRunner;
getprocInputHandler.addProcess(fRunner);
end;
fRunner.Execute;
//
@ -717,34 +713,35 @@ var
proc: TProcess;
lst: TStringList;
str: string;
msgs: ICEMessagesDisplay;
begin
proc := TProcess(sender);
lst := TStringList.Create;
msgs := getMessageDisplay;
try
processOutputToStrings(proc, lst);
for str in lst do
subjLmFromString(TCELogMessageSubject(fLogMessager),
str, Self, amcProj, amkBub);
msgs.message(str, Self, amcProj, amkBub);
finally
lst.Free;
end;
//
if not proc.Active then
if CEMainForm.processInput.process = proc then
CEMainForm.processInput.process := nil;
getprocInputHandler.removeProcess(proc);
end;
procedure TCEProject.compProcOutput(proc: TProcess);
var
lst: TStringList;
str: string;
msgs: ICEMessagesDisplay;
begin
lst := TStringList.Create;
msgs := getMessageDisplay;
try
processOutputToStrings(proc, lst);
for str in lst do
subjLmFromString(TCELogMessageSubject(fLogMessager),
str, Self, amcProj, amkAuto);
msgs.message(str, Self, amcProj, amkAuto);
finally
lst.Free;
end;

8
src/ce_staticexplorer.pas
View File

@ -23,8 +23,8 @@ type
procedure TreeFilterEdit1AfterFilter(Sender: TObject);
procedure TreeKeyPress(Sender: TObject; var Key: char);
private
fMsgs: ICEMessagesDisplay;
fDmdProc: TCheckedAsyncProcess;
fLogMessager: TCELogMessageSubject;
fActCopyIdent: TAction;
fActRefresh: TAction;
fActRefreshOnChange: TAction;
@ -97,7 +97,6 @@ constructor TCEStaticExplorerWidget.create(aOwner: TComponent);
var
png: TPortableNetworkGraphic;
begin
fLogMessager := TCELogMessageSubject.create;
fAutoRefresh := false;
fRefreshOnFocus := true;
fRefreshOnChange := false;
@ -160,13 +159,13 @@ begin
EntitiesConnector.removeObserver(self);
//
killProcess(fDmdProc);
fLogMessager.Free;
inherited;
end;
procedure TCEStaticExplorerWidget.SetVisible(Value: boolean);
begin
inherited;
getMessageDisplay(fMsgs);
if Value then
produceJsonInfo;
end;
@ -557,8 +556,7 @@ begin
'template' :ndCat := Tree.Items.AddChildObject(ndTmp, nme, ln);
'union' :ndCat := Tree.Items.AddChildObject(ndUni, nme, ln);
'variable' :ndCat := Tree.Items.AddChildObject(ndVar, nme, ln);
else subjLmFromString(fLogMessager, 'static explorer does not handle this kind: '
+ knd, nil, amcApp, amkWarn);
else fMsgs.message('static explorer does not handle this kind: '+ knd, nil, amcApp, amkWarn);
end;
if ndCat = nil then

1
src/ce_synmemo.pas
View File

@ -559,6 +559,7 @@ begin
inherited;
if (Button = mbMiddle) and (Shift = [ssCtrl]) then
Font.Size := fStoredFontSize
//TODO-cLCL&LAZ-specific: test this feature under gtk2/linux on next release, should work
else if Button = mbExtra1 then
fPositions.back
else if Button = mbExtra2 then

11
src/ce_todolist.pas
View File

@ -71,7 +71,7 @@ type
fDoc: TCESynMemo;
fToolProcess: TCheckedAsyncProcess;
fTodos: TTodoItems;
fLogMessager: TCELogMessageSubject;
fMsgs: ICEMessagesDisplay;
// ICEMultiDocObserver
procedure docNew(aDoc: TCESynMemo);
procedure docFocused(aDoc: TCESynMemo);
@ -173,7 +173,6 @@ var
begin
inherited;
fTodos := TTodoItems.Create(self);
fLogMessager := TCELogMessageSubject.create;
lstItems.OnDblClick := @lstItemsDoubleClick;
btnRefresh.OnClick := @btnRefreshClick;
fAutoRefresh := true;
@ -197,7 +196,6 @@ end;
destructor TCETodoListWidget.destroy;
begin
killToolProcess;
fLogMessager.Free;
inherited;
end;
@ -355,14 +353,15 @@ var
msg: string;
ctxt: TTodoContext;
begin
getMessageDisplay(fMsgs);
str := TStringList.Create;
try
processOutputToStrings(fToolProcess, str);
ctxt := getContext;
for msg in str do case ctxt of
tcNone: subjLmFromString(fLogMessager, msg, nil, amcMisc, amkAuto);
tcFile: subjLmFromString(fLogMessager, msg, fDoc, amcEdit, amkAuto);
tcProject:subjLmFromString(fLogMessager, msg, fProj, amcProj, amkAuto);
tcNone: fMsgs.message(msg, nil, amcMisc, amkAuto);
tcFile: fMsgs.message(msg, fDoc, amcEdit, amkAuto);
tcProject:fMsgs.message(msg, fProj, amcProj, amkAuto);
end;
finally
str.Free;

7
src/ce_tools.pas
View File

@ -23,7 +23,7 @@ type
fChainBefore: TStringList;
fChainAfter: TStringList;
//fShortcut: string;
fLogMessager: TCELogMessageSubject;
fMsgs: ICEMessagesDisplay;
procedure setParameters(aValue: TStringList);
procedure setChainBefore(aValue: TStringList);
procedure setChainAfter(aValue: TStringList);
@ -84,7 +84,6 @@ begin
fParameters := TStringList.create;
fChainBefore := TStringList.Create;
fChainAfter := TStringList.Create;
fLogMessager := TCELogMessageSubject.create;
end;
destructor TCEToolItem.destroy;
@ -92,7 +91,6 @@ begin
fParameters.Free;
fChainAfter.Free;
fChainBefore.Free;
fLogMessager.Free;
killProcess(fProcess);
inherited;
end;
@ -152,11 +150,12 @@ var
lst: TStringList;
str: string;
begin
getMessageDisplay(fMsgs);
lst := TStringList.Create;
try
processOutputToStrings(fProcess, lst);
for str in lst do
subjLmFromString(fLogMessager, str, nil, amcMisc, amkAuto);
fMsgs.message(str, nil, amcMisc, amkAuto);
finally
lst.Free;
end;