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

fix, in asyncprocess output has to be accumulated in the two events

This commit is contained in:
Basile Burg 2015-02-25 09:23:02 +01:00
parent b23f72deda
commit ac5c8e1ad4
2 changed files with 37 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
cetodo/cetodo.d
View File

@ -225,6 +225,7 @@ void main(string[] args)
// samples for testing the program as a runnable ('Compile and runfile ...') with '<CFF>' // samples for testing the program as a runnable ('Compile and runfile ...') with '<CFF>'
// fixme-p8: èuèuuè``u`èuùè
// fixme-p8: fixme also handled // fixme-p8: fixme also handled
// TODO-cINVALID_because_no_content: // TODO-cINVALID_because_no_content:
// TODO: set this property as const() to set it read only. // TODO: set this property as const() to set it read only.

78
src/ce_todolist.pas
View File

@ -79,11 +79,12 @@ type
procedure handleListClick(Sender: TObject); procedure handleListClick(Sender: TObject);
procedure mnuAutoRefreshClick(Sender: TObject); procedure mnuAutoRefreshClick(Sender: TObject);
private private
fToolOutput: TMemoryStream;
fAutoRefresh: Boolean; fAutoRefresh: Boolean;
fSingleClick: Boolean; fSingleClick: Boolean;
fProj: TCEProject; fProj: TCEProject;
fDoc: TCESynMemo; fDoc: TCESynMemo;
fToolProcess: TCheckedAsyncProcess; fToolProc: TCheckedAsyncProcess;
fTodos: TTodoItems; fTodos: TTodoItems;
fMsgs: ICEMessagesDisplay; fMsgs: ICEMessagesDisplay;
fOptions: TCETodoOptions; fOptions: TCETodoOptions;
@ -107,7 +108,8 @@ type
function getContext: TTodoContext; function getContext: TTodoContext;
procedure killToolProcess; procedure killToolProcess;
procedure callToolProcess; procedure callToolProcess;
procedure procOutput(sender: TObject); procedure toolTerminated(sender: TObject);
procedure toolOutputData(sender: TObject);
procedure procOutputDbg(sender: TObject); procedure procOutputDbg(sender: TObject);
procedure clearTodoList; procedure clearTodoList;
procedure fillTodoList; procedure fillTodoList;
@ -193,6 +195,7 @@ var
begin begin
inherited; inherited;
// //
fToolOutput := TMemoryStream.Create;
fOptions := TCETodoOptions.Create(self); fOptions := TCETodoOptions.Create(self);
fOptions.autoRefresh := true; fOptions.autoRefresh := true;
fOptions.Name := 'todolistOptions'; fOptions.Name := 'todolistOptions';
@ -230,6 +233,7 @@ destructor TCETodoListWidget.destroy;
begin begin
fOptions.saveToFile(getCoeditDocPath + OptFname); fOptions.saveToFile(getCoeditDocPath + OptFname);
killToolProcess; killToolProcess;
fToolOutput.Free;
inherited; inherited;
end; end;
@ -364,11 +368,11 @@ end;
procedure TCETodoListWidget.killToolProcess; procedure TCETodoListWidget.killToolProcess;
begin begin
if fToolProcess = nil then exit; if fToolProc = nil then exit;
// //
fToolProcess.Terminate(0); fToolProc.Terminate(0);
fToolProcess.Free; fToolProc.Free;
fToolProcess := nil; fToolProc := nil;
end; end;
procedure TCETodoListWidget.callToolProcess; procedure TCETodoListWidget.callToolProcess;
@ -382,26 +386,19 @@ begin
// //
killToolProcess; killToolProcess;
// process parameter // process parameter
fToolProcess := TCheckedAsyncProcess.Create(nil); fToolProc := TCheckedAsyncProcess.Create(nil);
fToolProcess.Executable := ToolExeName; fToolProc.Executable := ToolExeName;
fToolProcess.Options := [poUsePipes]; fToolProc.Options := [poUsePipes];
fToolProcess.ShowWindow := swoHIDE; fToolProc.ShowWindow := swoHIDE;
fToolProcess.CurrentDirectory := ExtractFileDir(Application.ExeName); fToolProc.CurrentDirectory := ExtractFileDir(Application.ExeName);
fToolProc.OnTerminate := @toolTerminated;
// Something not quite clear: fToolProc.OnReadData := @toolOutputData;
// --------------------------
// actually the two events can be called, depending
// on the amount of data in the output.
// many: OnReadData is called.
// few: OnTerminate is called.
fToolProcess.OnTerminate := @procOutput;
fToolProcess.OnReadData := @procOutput;
// files passed to the tool argument // files passed to the tool argument
if ctxt = tcProject then fToolProcess.Parameters.AddText(symbolExpander.get('<CPFS>')) if ctxt = tcProject then fToolProc.Parameters.AddText(symbolExpander.get('<CPFS>'))
else fToolProcess.Parameters.Add(symbolExpander.get('<CFF>')); else fToolProc.Parameters.Add(symbolExpander.get('<CFF>'));
// //
fToolProcess.Execute; fToolProc.Execute;
end; end;
procedure TCETodoListWidget.procOutputDbg(sender: TObject); procedure TCETodoListWidget.procOutputDbg(sender: TObject);
@ -413,7 +410,7 @@ begin
getMessageDisplay(fMsgs); getMessageDisplay(fMsgs);
str := TStringList.Create; str := TStringList.Create;
try try
processOutputToStrings(fToolProcess, str); processOutputToStrings(fToolProc, str);
ctxt := getContext; ctxt := getContext;
for msg in str do case ctxt of for msg in str do case ctxt of
tcNone: fMsgs.message(msg, nil, amcMisc, amkAuto); tcNone: fMsgs.message(msg, nil, amcMisc, amkAuto);
@ -425,29 +422,22 @@ begin
end; end;
end; end;
procedure TCETodoListWidget.procOutput(sender: TObject); procedure TCETodoListWidget.toolOutputData(sender: TObject);
var
str: TMemoryStream;
cnt: Integer;
sum: Integer;
const
buffSz = 1024;
begin begin
sum := 0; processOutputToStream(fToolProc, fToolOutput);
str := TMemoryStream.Create;
try
while fToolProcess.Output.NumBytesAvailable <> 0 do begin
str.SetSize(sum + buffSz);
cnt := fToolProcess.Output.Read((str.Memory + sum)^, buffSz);
sum += cnt;
end; end;
str.SetSize(sum);
str.Position := 0; procedure TCETodoListWidget.toolTerminated(sender: TObject);
fTodos.loadFromTxtStream(str); begin
processOutputToStream(fToolProc, fToolOutput);
fToolOutput.Position := 0;
//TODO-cbugfix: UTF chars in TODO comments bug either in the widget or the tool, symptom: empty todo list, conditions: to determine.
//fToolOutput.SaveToFile('C:\cetodo_widgetside.txt');
fTodos.loadFromTxtStream(fToolOutput);
fillTodoList; fillTodoList;
finally fToolProc.OnTerminate := nil;
str.Free; fToolProc.OnReadData := nil;
end; fToolOutput.Clear;
end; end;
procedure TCETodoListWidget.clearTodoList; procedure TCETodoListWidget.clearTodoList;