diff --git a/src/ce_main.pas b/src/ce_main.pas index 44d43483..e91494f1 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -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 diff --git a/src/ce_messages.pas b/src/ce_messages.pas index 431d5ed3..c44a1fac 100644 --- a/src/ce_messages.pas +++ b/src/ce_messages.pas @@ -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; diff --git a/src/ce_miniexplorer.pas b/src/ce_miniexplorer.pas index 01bd839f..26524eb1 100644 --- a/src/ce_miniexplorer.pas +++ b/src/ce_miniexplorer.pas @@ -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; diff --git a/src/ce_procinput.pas b/src/ce_procinput.pas index 43754c64..2e3c5642 100644 --- a/src/ce_procinput.pas +++ b/src/ce_procinput.pas @@ -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; diff --git a/src/ce_project.pas b/src/ce_project.pas index 8c519bc0..473bd59a 100644 --- a/src/ce_project.pas +++ b/src/ce_project.pas @@ -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; diff --git a/src/ce_staticexplorer.pas b/src/ce_staticexplorer.pas index f2dfa342..765d3ad4 100644 --- a/src/ce_staticexplorer.pas +++ b/src/ce_staticexplorer.pas @@ -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 diff --git a/src/ce_synmemo.pas b/src/ce_synmemo.pas index d25784ec..8155e869 100644 --- a/src/ce_synmemo.pas +++ b/src/ce_synmemo.pas @@ -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 diff --git a/src/ce_todolist.pas b/src/ce_todolist.pas index 0efd9cb4..891e9dbc 100644 --- a/src/ce_todolist.pas +++ b/src/ce_todolist.pas @@ -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; diff --git a/src/ce_tools.pas b/src/ce_tools.pas index 1ade2103..50a70882 100644 --- a/src/ce_tools.pas +++ b/src/ce_tools.pas @@ -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;