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 5

This commit is contained in:
Basile Burg 2014-11-10 10:03:41 +01:00
parent 4fba5dff2c
commit 58616ecb7d
8 changed files with 80 additions and 158 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/ce_customtools.pas
View File

@ -22,6 +22,7 @@ type
fShortcut: string;
fLogMessager: TCELogMessageSubject;
procedure setParameters(const aValue: TStringList);
procedure processOUtput(sender: TObject);
published
property toolAlias: string read fToolAlias write fToolAlias;
property options: TProcessOptions read fOpts write fOpts;
@ -83,8 +84,10 @@ var
i: Integer;
begin
killProcess(fProcess);
fProcess := TAsyncProcess.Create(nil);
//
fProcess := TAsyncProcess.Create(nil);
fProcess.OnReadData:= @processOutput;
fProcess.OnTerminate:= @processOutput;
fProcess.Options := fOpts;
if fExecutable <> '' then
fProcess.Executable := CEMainForm.expandSymbolicString(fExecutable);
@ -95,10 +98,24 @@ begin
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, amcMisc, amkBub);
fProcess.Execute;
end;
procedure TCEToolItem.processOutput(sender: TObject);
var
lst: TStringList;
str: string;
begin
lst := TStringList.Create;
try
processOutputToStrings(fProcess, lst);
for str in lst do
subjLmFromString(fLogMessager, str, nil, amcMisc, amkAuto);
finally
lst.Free;
end;
end;
constructor TCETools.create(aOwner: TComponent);
begin
inherited;

21
src/ce_interfaces.pas
View File

@ -151,9 +151,7 @@ type
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);
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.
@ -201,9 +199,7 @@ type
(**
* TCELogMessageSubject primitives.
*)
procedure subjLmStandard(aSubject: TCELogMessageSubject; const aValue: string;
aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjLmProcess(aSubject: TCELogMessageSubject; const aValue: TProcess;
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}
@ -339,22 +335,13 @@ begin
exit(aObject is ICELogMessageObserver);
end;
procedure subjLmStandard(aSubject: TCELogMessageSubject; const aValue: string;
procedure subjLmFromString(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);
(fObservers.Items[i] as ICELogMessageObserver).lmFromString(aValue, aData, aCtxt, aKind);
end;
procedure subjLmClearByContext(aSubject: TCELogMessageSubject; aCtxt: TCEAppMessageCtxt);

100
src/ce_main.pas
View File

@ -241,7 +241,6 @@ type
// run & exec sub routines
procedure asyncprocOutput(sender: TObject);
procedure asyncprocTerminate(sender: TObject);
//procedure ProcessOutputToMsg(const aProcess: TProcess;aCtxt: TMessageContext = mcUnknown);
procedure compileAndRunFile(const edIndex: NativeInt; const runArgs: string = '');
// file sub routines
@ -728,7 +727,7 @@ begin
if fMesgWidg = nil then
ce_common.dlgOkError(E.Message)
else
fMesgWidg.lmStandard(E.Message, nil, amcApp, amkErr);
fMesgWidg.lmFromString(E.Message, nil, amcApp, amkErr);
end;
procedure TCEMainForm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
@ -1212,75 +1211,49 @@ end;
{$ENDREGION}
{$REGION run -------------------------------------------------------------------}
//procedure TCEMainForm.ProcessOutputToMsg(const aProcess: TProcess; aCtxt: TMessageContext = mcUnknown);
//var
// str: TMemoryStream;
// lns: TStringList;
// readCnt: LongInt;
// readSz: LongInt;
// ioBuffSz: LongInt;
// dt: PMessageItemData;
// i: NativeInt;
// msg: string;
// hasRead: boolean;
//begin
// If not (poUsePipes in aProcess.Options) then exit;
// //
// readCnt := 0;
// readSz := 0;
// hasRead := false;
// ioBuffSz := aProcess.PipeBufferSize;
// str := TMemorystream.Create;
// lns := TStringList.Create;
// try
// while aProcess.Output.NumBytesAvailable <> 0 do
// begin
// hasRead := true;
// str.Size := str.Size + ioBuffSz;
// readCnt := aProcess.Output.Read((str.Memory + readSz)^, ioBuffSz);
// readSz += readCnt;
// end;
// str.Size := readSz;
// lns.LoadFromStream(Str);
// for i:= 0 to lns.Count-1 do begin
// msg := lns.Strings[i];
// dt := newMessageData;
// dt^.ctxt := aCtxt;
// dt^.project := fProject;
// dt^.position := getLineFromDmdMessage(msg);
// if openFileFromDmdMessage(msg) then
// dt^.ctxt := mcEditor;
// dt^.editor := fDoc;
// fEditWidg.endUpdatebyDelay; // messages would be cleared by the delayed module name detection.
// //fMesgWidg.addMessage(msg, dt);
// application.ProcessMessages;
// end;
// finally
// str.Free;
// lns.Free;
// if hasRead then
// fMesgWidg.scrollToBack;
// end;
//end;
procedure TCEMainForm.asyncprocOutput(sender: TObject);
var
proc: TProcess;
lst: TStringList;
str: string;
begin
proc := TProcess(sender);
if proc = fRunProc then
subjLmProcess(fLogMessager, TAsyncProcess(sender), nil, amcEdit, amkBub);
lst := TStringList.Create;
try
processOutputToStrings(proc, lst);
if proc = fRunProc then for str in lst do
subjLmFromString(fLogMessager, str, fDoc, amcEdit, amkBub);
finally
lst.Free;
end;
end;
procedure TCEMainForm.asyncprocTerminate(sender: TObject);
var
proc: TProcess;
lst: TStringList;
str: string;
begin
proc := TProcess(sender);
//ProcessOutputToMsg(TAsyncProcess(sender), mcEditor);
subjLmProcess(fLogMessager, proc, nil, amcEdit, amkBub);
if proc = fRunProc then
FreeRunnableProc;
lst := TStringList.Create;
try
processOutputToStrings(proc, lst);
// runnable module
if proc = fRunProc then
begin
for str in lst do
subjLmFromString(fLogMessager, str, fDoc, amcEdit, amkBub);
FreeRunnableProc;
// runnable compiler
end else
if proc.Executable = DCompiler then
begin
for str in lst do
subjLmFromString(fLogMessager, str, fDoc, amcEdit, amkAuto);
end;
finally
lst.Free;
end;
if proc = fPrInpWidg.process then
fPrInpWidg.process := nil;
end;
@ -1304,7 +1277,7 @@ begin
try
subjLmClearByData(fLogMessager, editor);
subjLmStandard(fLogMessager, 'compiling ' + shortenPath(editor.fileName,25),
subjLmFromString(fLogMessager, 'compiling ' + shortenPath(editor.fileName,25),
editor, amcEdit, amkInf);
if fileExists(editor.fileName) then editor.save
@ -1324,12 +1297,11 @@ begin
LibraryManager.getLibFiles(nil, dmdproc.Parameters);
LibraryManager.getLibSources(nil, dmdproc.Parameters);
dmdproc.Execute;
while dmdproc.Running do
subjLmProcess(fLogMessager, dmdProc, editor, amcEdit, amkInf);
while dmdproc.Running do asyncprocOutput(dmdProc);
if (dmdProc.ExitStatus = 0) then
begin
subjLmStandard(fLogMessager, shortenPath(editor.fileName,25)
subjLmFromString(fLogMessager, shortenPath(editor.fileName,25)
+ ' successfully compiled', editor, amcEdit, amkInf);
fRunProc.CurrentDirectory := extractFilePath(fRunProc.Executable);
@ -1340,7 +1312,7 @@ begin
sysutils.DeleteFile(fname + objExt);
end
else begin
subjLmStandard(fLogMessager, shortenPath(editor.fileName,25)
subjLmFromString(fLogMessager, shortenPath(editor.fileName,25)
+ ' has not been compiled', editor, amcEdit, amkErr);
end;

5
src/ce_messages.lfm
View File

@ -58,6 +58,7 @@ inherited CEMessagesWidget: TCEMessagesWidget
Wrapable = False
object btnSelAll: TToolButton
Left = 1
Hint = 'unfiltered messages'
Top = 2
Caption = 'All'
Down = True
@ -71,6 +72,7 @@ inherited CEMessagesWidget: TCEMessagesWidget
end
object btnSelEdit: TToolButton
Left = 106
Hint = 'messages related to the current document'
Top = 2
Caption = 'Editor'
end
@ -83,6 +85,7 @@ inherited CEMessagesWidget: TCEMessagesWidget
end
object btnSelProj: TToolButton
Left = 211
Hint = 'message related to the current project'
Top = 2
Caption = 'Project'
end
@ -95,6 +98,7 @@ inherited CEMessagesWidget: TCEMessagesWidget
end
object btnSelApp: TToolButton
Left = 316
Hint = 'messages related to Coedit'
Top = 2
Caption = 'Application'
end
@ -107,6 +111,7 @@ inherited CEMessagesWidget: TCEMessagesWidget
end
object btnSelMisc: TToolButton
Left = 421
Hint = 'miscellaneous messages, custom tools output, etc'
Top = 2
Caption = 'Misc.'
end

69
src/ce_messages.pas
View File

@ -12,22 +12,16 @@ uses
type
(**
* the struct linked to a log message. allow to be filtered.
*)
PMessageData = ^TMessageData;
TMessageData = record
ctxt: TCEAppMessageCtxt;
data: Pointer;
end;
// keep trace of the initial info sent with a TProcess
PProcessMessage = ^TProcessMessage;
TProcessMessage = record
aData: Pointer;
aCtxt: TCEAppMessageCtxt;
aKind: TCEAppMessageKind;
end;
{ TCEMessagesWidget }
TCEMessagesWidget = class(TCEWidget, ICEMultiDocObserver, ICEProjectObserver, ICELogMessageObserver)
imgList: TImageList;
List: TTreeView;
@ -62,9 +56,6 @@ type
procedure actSelAllExecute(Sender: TObject);
procedure setMaxMessageCount(aValue: Integer);
procedure listDeletion(Sender: TObject; Node: TTreeNode);
procedure processOutput(Sender: TObject);
procedure processTerminate(Sender: TObject);
procedure logProcessOutput(const aProcess: TProcess);
procedure selCtxtClick(Sender: TObject);
function iconIndex(aKind: TCEAppMessageKind): Integer;
//
@ -94,10 +85,7 @@ 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 lmFromString(const aValue: string; aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
procedure lmClearbyContext(aCtxt: TCEAppMessageCtxt);
procedure lmClearbyData(aData: Pointer);
end;
@ -365,7 +353,7 @@ end;
{$ENDREGION}
{$REGION ICELogMessageObserver -------------------------------------------------}
procedure TCEMessagesWidget.lmStandard(const aValue: string; aData: Pointer;
procedure TCEMessagesWidget.lmFromString(const aValue: string; aData: Pointer;
aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
var
dt: PMessageData;
@ -385,53 +373,6 @@ begin
Application.ProcessMessages;
end;
procedure TCEMessagesWidget.lmProcess(const aValue: TProcess; aData: Pointer;
aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
begin
if not (poUsePipes in aValue.Options) then
exit;
//
aValue.Tag := (Byte(aCtxt) shl 8) + Byte(aKind);
//
if (aValue is TAsyncProcess) then
begin
TAsyncProcess(aValue).OnReadData := @processOutput;
TAsyncProcess(aValue).OnTerminate := @processTerminate;
end;
if aValue.Output = nil then
exit;
// always process messages: a TAsyncProcess may be already terminated.
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
// initial info should be in a TProcessMessage
lmStandard(str, nil, amcAll, amkBub);
finally
lst.Free;
Application.ProcessMessages;
filterMessages(fCtxt);
end;
end;
procedure TCEMessagesWidget.lmClearByContext(aCtxt: TCEAppMessageCtxt);
var
i: Integer;

2
src/ce_miniexplorer.pas
View File

@ -257,7 +257,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 subjLmStandard(fLogMessager,
if not shellOpen(fname) then subjLmFromString(fLogMessager,
(format('the shell failed to open "%s"', [shortenPath(fname, 25)])),
nil, amcMisc, amkErr);
end;

18
src/ce_project.pas
View File

@ -501,7 +501,7 @@ begin
config := currentConfiguration;
if config = nil then
begin
subjLmStandard(TCELogMessageSubject(fLogMessager),
subjLmFromString(TCELogMessageSubject(fLogMessager),
'unexpected project error: no active configuration', Self, amcProj, amkErr);
exit;
end;
@ -509,7 +509,7 @@ begin
subjLmClearByData(TCELogMessageSubject(fLogMessager), Self);
//
if not runPrePostProcess(config.preBuildProcess) then
subjLmStandard(TCELogMessageSubject(fLogMessager),
subjLmFromString(TCELogMessageSubject(fLogMessager),
'project warning: the pre-compilation process has not been properly executed', Self, amcProj, amkWarn);
//
prjname := shortenPath(filename, 25);
@ -517,7 +517,7 @@ begin
olddir := '';
getDir(0, olddir);
try
subjLmStandard(TCELogMessageSubject(fLogMessager),
subjLmFromString(TCELogMessageSubject(fLogMessager),
'compiling ' + prjname, Self, amcProj, amkInf);
prjpath := extractFilePath(fileName);
if directoryExists(prjpath) then
@ -533,15 +533,15 @@ begin
while compilProc.Running do
compProcOutput(compilproc);
if compilproc.ExitStatus = 0 then begin
subjLmStandard(TCELogMessageSubject(fLogMessager),
subjLmFromString(TCELogMessageSubject(fLogMessager),
prjname + ' has been successfully compiled', Self, amcProj, amkInf);
result := true;
end else
subjLmStandard(TCELogMessageSubject(fLogMessager),
subjLmFromString(TCELogMessageSubject(fLogMessager),
prjname + ' has not been compiled', Self, amcProj, amkWarn);
if not runPrePostProcess(config.PostBuildProcess) then
subjLmStandard(TCELogMessageSubject(fLogMessager),
subjLmFromString(TCELogMessageSubject(fLogMessager),
'project warning: the post-compilation process has not been properly executed', Self, amcProj, amkWarn);
finally
@ -572,7 +572,7 @@ begin
//
if not fileExists(outputFilename) then
begin
subjLmStandard(TCELogMessageSubject(fLogMessager),
subjLmFromString(TCELogMessageSubject(fLogMessager),
'output executable missing: ' + shortenPath(outputFilename, 25), Self, amcProj, amkErr);
exit;
end;
@ -600,7 +600,7 @@ begin
try
processOutputToStrings(proc, lst);
for str in lst do
subjLmStandard(TCELogMessageSubject(fLogMessager),
subjLmFromString(TCELogMessageSubject(fLogMessager),
str, Self, amcProj, amkBub);
finally
lst.Free;
@ -616,7 +616,7 @@ begin
try
processOutputToStrings(proc, lst);
for str in lst do
subjLmStandard(TCELogMessageSubject(fLogMessager),
subjLmFromString(TCELogMessageSubject(fLogMessager),
str, Self, amcProj, amkAuto);
finally
lst.Free;

2
src/ce_staticexplorer.pas
View File

@ -484,7 +484,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 subjLmStandard(fLogMessager, 'static explorer does not handle this kind: ' + knd, nil, amcApp, amkWarn);
else subjLmFromString(fLogMessager, 'static explorer does not handle this kind: ' + knd, nil, amcApp, amkWarn);
end;
if ndCat = nil then