messages rewrite using internal observer system 3

src/ce_customtools.pas

@@ -95,7 +95,7 @@ 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, amcTool, amkBub);
+  subjLmProcess(fLogMessager, fProcess, nil, amcMisc, amkBub);
   fProcess.Execute;
 end;
 

src/ce_interfaces.pas

@@ -140,9 +140,9 @@ type
 
 
   /// describes the message kind, when Auto implies that a ICELogMessageObserver guess the kind.
-  TCEAppMessageKind = (amkAuto, amkBub, amkInf, amkWarn, amkErr);
+  TCEAppMessageKind = (amkAuto, amkBub, amkInf, amkHint, amkWarn, amkErr);
   /// describes the message context. Used by a ICELogMessageObserver to filter the messages.
-  TCEAppMessageCtxt = (amcApp, amcTool, amcProj, amcEdit);
+  TCEAppMessageCtxt = (amcAll, amcEdit, amcProj, amcApp, amcMisc);
 
   (**
    * An implementer gets some log messages.
@@ -154,6 +154,10 @@ type
     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);
+    // 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);
   end;
   (**
    * An implementer sends some log messages.
@@ -201,6 +205,8 @@ type
       aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind); {$IFDEF RELEASE}inline;{$ENDIF}
   procedure subjLmProcess(aSubject: TCELogMessageSubject; const aValue: TProcess;
       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}
 
 implementation
 
@@ -351,5 +357,23 @@ begin
     (fObservers.Items[i] as ICELogMessageObserver).lmProcess(aValue, aData, aCtxt, aKind);
 end;
 
+procedure subjLmClearByContext(aSubject: TCELogMessageSubject; aCtxt: TCEAppMessageCtxt);
+var
+  i: Integer;
+begin
+  with aSubject do for i:= 0 to fObservers.Count-1 do
+    (fObservers.Items[i] as ICELogMessageObserver).lmClearByContext(aCtxt);
+end;
+
+
+procedure subjLmClearByData(aSubject: TCELogMessageSubject; aData: Pointer);
+var
+  i: Integer;
+begin
+  with aSubject do for i:= 0 to fObservers.Count-1 do
+    (fObservers.Items[i] as ICELogMessageObserver).lmClearByData(aData);
+end;
+
+
 {$ENDREGION}
 end.

src/ce_main.pas

@@ -241,7 +241,7 @@ type
     // run & exec sub routines
     procedure asyncprocOutput(sender: TObject);
     procedure asyncprocTerminate(sender: TObject);
-    procedure ProcessOutputToMsg(const aProcess: TProcess;aCtxt: TMessageContext = mcUnknown);
+    //procedure ProcessOutputToMsg(const aProcess: TProcess;aCtxt: TMessageContext = mcUnknown);
     procedure compileAndRunFile(const edIndex: NativeInt; const runArgs: string = '');
 
     // file sub routines
@@ -723,9 +723,9 @@ end;
 
 procedure TCEMainForm.ApplicationProperties1Exception(Sender: TObject;E: Exception);
 begin
-  if fMesgWidg = nil then
+  //if fMesgWidg = nil then
-    ce_common.dlgOkError(E.Message)
+    //ce_common.dlgOkError(E.Message)
-  else fMesgWidg.addCeErr(E.Message);
+  //else fMesgWidg.addCeErr(E.Message);
 end;
 
 procedure TCEMainForm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
@@ -1209,56 +1209,56 @@ end;
 {$ENDREGION}
 
 {$REGION run -------------------------------------------------------------------}
-procedure TCEMainForm.ProcessOutputToMsg(const aProcess: TProcess; aCtxt: TMessageContext = mcUnknown);
+//procedure TCEMainForm.ProcessOutputToMsg(const aProcess: TProcess; aCtxt: TMessageContext = mcUnknown);
-var
+//var
-  str: TMemoryStream;
+//  str: TMemoryStream;
-  lns: TStringList;
+//  lns: TStringList;
-  readCnt: LongInt;
+//  readCnt: LongInt;
-  readSz: LongInt;
+//  readSz: LongInt;
-  ioBuffSz: LongInt;
+//  ioBuffSz: LongInt;
-  dt: PMessageItemData;
+//  dt: PMessageItemData;
-  i: NativeInt;
+//  i: NativeInt;
-  msg: string;
+//  msg: string;
-  hasRead: boolean;
+//  hasRead: boolean;
-begin
+//begin
-  If not (poUsePipes in aProcess.Options) then exit;
+//  If not (poUsePipes in aProcess.Options) then exit;
-  //
+//  //
-  readCnt := 0;
+//  readCnt := 0;
-  readSz := 0;
+//  readSz := 0;
-  hasRead := false;
+//  hasRead := false;
-  ioBuffSz := aProcess.PipeBufferSize;
+//  ioBuffSz := aProcess.PipeBufferSize;
-  str := TMemorystream.Create;
+//  str := TMemorystream.Create;
-  lns := TStringList.Create;
+//  lns := TStringList.Create;
-  try
+//  try
-    while aProcess.Output.NumBytesAvailable <> 0 do
+//    while aProcess.Output.NumBytesAvailable <> 0 do
-    begin
+//    begin
-      hasRead := true;
+//      hasRead := true;
-      str.Size := str.Size + ioBuffSz;
+//      str.Size := str.Size + ioBuffSz;
-      readCnt := aProcess.Output.Read((str.Memory + readSz)^, ioBuffSz);
+//      readCnt := aProcess.Output.Read((str.Memory + readSz)^, ioBuffSz);
-      readSz += readCnt;
+//      readSz += readCnt;
-    end;
+//    end;
-    str.Size := readSz;
+//    str.Size := readSz;
-    lns.LoadFromStream(Str);
+//    lns.LoadFromStream(Str);
-    for i:= 0 to lns.Count-1 do begin
+//    for i:= 0 to lns.Count-1 do begin
-      msg := lns.Strings[i];
+//      msg := lns.Strings[i];
-      dt := newMessageData;
+//      dt := newMessageData;
-      dt^.ctxt := aCtxt;
+//      dt^.ctxt := aCtxt;
-      dt^.project := fProject;
+//      dt^.project := fProject;
-      dt^.position := getLineFromDmdMessage(msg);
+//      dt^.position := getLineFromDmdMessage(msg);
-      if openFileFromDmdMessage(msg) then
+//      if openFileFromDmdMessage(msg) then
-        dt^.ctxt := mcEditor;
+//        dt^.ctxt := mcEditor;
-      dt^.editor := fDoc;
+//      dt^.editor := fDoc;
-      fEditWidg.endUpdatebyDelay; // messages would be cleared by the delayed module name detection.
+//      fEditWidg.endUpdatebyDelay; // messages would be cleared by the delayed module name detection.
-      fMesgWidg.addMessage(msg, dt);
+//      //fMesgWidg.addMessage(msg, dt);
-      application.ProcessMessages;
+//      application.ProcessMessages;
-    end;
+//    end;
-  finally
+//  finally
-    str.Free;
+//    str.Free;
-    lns.Free;
+//    lns.Free;
-    if hasRead then
+//    if hasRead then
-      fMesgWidg.scrollToBack;
+//      fMesgWidg.scrollToBack;
-  end;
+//  end;
-end;
+//end;
 
 procedure TCEMainForm.asyncprocOutput(sender: TObject);
 var
@@ -1266,7 +1266,7 @@ var
 begin
   proc := TProcess(sender);
   if proc = fRunProc then
-    ProcessOutputToMsg(TAsyncProcess(sender), mcEditor);
+    subjLmProcess(fLogMessager, TAsyncProcess(sender), nil, amcEdit, amkBub);
 end;
 
 procedure TCEMainForm.asyncprocTerminate(sender: TObject);
@@ -1274,7 +1274,8 @@ var
   proc: TProcess;
 begin
   proc := TProcess(sender);
-  ProcessOutputToMsg(TAsyncProcess(sender), mcEditor);
+  //ProcessOutputToMsg(TAsyncProcess(sender), mcEditor);
+  subjLmProcess(fLogMessager, proc, nil, amcEdit, amkBub);
   if proc = fRunProc then
     FreeRunnableProc;
   if proc = fPrInpWidg.process then
@@ -1299,8 +1300,9 @@ begin
   editor  := fEditWidg.editor[edIndex];
   try
 
-    fMesgWidg.ClearMessages(mcEditor);
+    subjLmClearByData(fLogMessager, editor);
-    fMesgWidg.addCeInf('compiling ' + editor.fileName, mcEditor);
+    subjLmStandard(fLogMessager, 'compiling ' + shortenPath(editor.fileName,25),
+      editor, amcEdit, amkInf);
 
     if fileExists(editor.fileName) then editor.save
     else editor.saveToFile(editor.tempFilename);
@@ -1319,11 +1321,14 @@ begin
     LibraryManager.getLibFiles(nil, dmdproc.Parameters);
     LibraryManager.getLibSources(nil, dmdproc.Parameters);
     dmdproc.Execute;
-    repeat ProcessOutputToMsg(dmdproc, mcEditor) until not dmdproc.Running;
+    while dmdproc.Running do
+      subjLmProcess(fLogMessager, dmdProc, editor, amcEdit, amkInf);
+
     if (dmdProc.ExitStatus = 0) then
     begin
-      ProcessOutputToMsg(dmdproc, mcEditor);
+      subjLmStandard(fLogMessager, shortenPath(editor.fileName,25)
-      fMesgWidg.addCeInf(editor.fileName + ' successfully compiled', mcEditor );
+        + ' successfully compiled', editor, amcEdit, amkInf);
+
       fRunProc.CurrentDirectory := extractFilePath(fRunProc.Executable);
       fRunProc.Parameters.DelimitedText := expandSymbolicString(runArgs);
       fRunProc.Executable := fname + exeExt;
@@ -1332,8 +1337,8 @@ begin
       sysutils.DeleteFile(fname + objExt);
     end
     else begin
-      ProcessOutputToMsg(dmdproc, mcEditor);
+      subjLmStandard(fLogMessager, shortenPath(editor.fileName,25)
-      fMesgWidg.addCeErr(editor.fileName  + ' has not been compiled', mcEditor );
+        + ' has not been compiled', editor, amcEdit, amkErr);
     end;
 
   finally

src/ce_messages.lfm

@@ -1,27 +1,27 @@
 inherited CEMessagesWidget: TCEMessagesWidget
-  Left = 812
+  Left = 1135
   Height = 172
-  Top = 258
+  Top = 183
-  Width = 744
+  Width = 739
   Caption = 'Messages'
   ClientHeight = 172
-  ClientWidth = 744
+  ClientWidth = 739
   inherited Back: TPanel
     Height = 172
-    Width = 744
+    Width = 739
     ClientHeight = 172
-    ClientWidth = 744
+    ClientWidth = 739
     inherited Content: TPanel
       Height = 172
-      Width = 744
+      Width = 739
       ClientHeight = 172
-      ClientWidth = 744
+      ClientWidth = 739
       PopupMenu = nil
       object List: TTreeView[0]
         Left = 2
-        Height = 168
+        Height = 140
-        Top = 2
+        Top = 30
-        Width = 740
+        Width = 735
         Align = alClient
         BorderSpacing.Around = 2
         DefaultItemHeight = 16
@@ -42,15 +42,84 @@ inherited CEMessagesWidget: TCEMessagesWidget
         OnKeyDown = ListKeyDown
         Options = [tvoAllowMultiselect, tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoToolTips, tvoThemedDraw]
       end
+      object selCtxt: TToolBar[1]
+        Left = 2
+        Height = 26
+        Top = 2
+        Width = 735
+        AutoSize = True
+        BorderSpacing.Around = 2
+        BorderWidth = 150
+        ButtonHeight = 24
+        ButtonWidth = 100
+        Flat = False
+        ShowCaptions = True
+        TabOrder = 1
+        Wrapable = False
+        object btnSelAll: TToolButton
+          Left = 1
+          Top = 2
+          Caption = 'All'
+          Down = True
+        end
+        object ToolButton2: TToolButton
+          Left = 101
+          Top = 2
+          Width = 5
+          Caption = 'ToolButton2'
+          Style = tbsDivider
+        end
+        object btnSelEdit: TToolButton
+          Left = 106
+          Top = 2
+          Caption = 'Editor'
+        end
+        object ToolButton4: TToolButton
+          Left = 206
+          Top = 2
+          Width = 5
+          Caption = 'ToolButton4'
+          Style = tbsDivider
+        end
+        object btnSelProj: TToolButton
+          Left = 211
+          Top = 2
+          Caption = 'Project'
+        end
+        object ToolButton8: TToolButton
+          Left = 311
+          Top = 2
+          Width = 5
+          Caption = 'ToolButton8'
+          Style = tbsDivider
+        end
+        object btnSelApp: TToolButton
+          Left = 316
+          Top = 2
+          Caption = 'Application'
+        end
+        object ToolButton10: TToolButton
+          Left = 416
+          Top = 2
+          Width = 5
+          Caption = 'ToolButton10'
+          Style = tbsDivider
+        end
+        object btnSelMisc: TToolButton
+          Left = 421
+          Top = 2
+          Caption = 'Misc.'
+        end
+      end
     end
   end
   inherited contextMenu: TPopupMenu
-    left = 8
+    left = 16
-    top = 8
+    top = 40
   end
   object imgList: TImageList[2]
-    left = 40
+    left = 56
-    top = 8
+    top = 40
     Bitmap = {
       4C69050000001000000010000000CF986200D1996200D1996234D0965DBCCF94
       5BFFCE945AFFCE935AFFCE935AFFCE935AFFCE935AFFCE945AFFCF945BFFD096

src/ce_messages.pas

@@ -11,19 +11,36 @@ uses
 
 type
 
-  TMessageContext = (mcUnknown, mcProject, mcEditor, mcApplication);
 
-  PMessageItemData = ^TMessageItemData;
+  PMessageData = ^TMessageData;
-  TMessageItemData = record
+  TMessageData = record
-    ctxt: TMessageContext;
+    ctxt: TCEAppMessageCtxt;
-    editor: TCESynMemo;
+    data: Pointer;
-    project: TCEProject;
-    position: TPoint;
   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;
+    selCtxt: TToolBar;
+    btnSelAll: TToolButton;
+    ToolButton10: TToolButton;
+    btnSelMisc: TToolButton;
+    ToolButton2: TToolButton;
+    btnSelEdit: TToolButton;
+    ToolButton4: TToolButton;
+    btnSelProj: TToolButton;
+    ToolButton8: TToolButton;
+    btnSelApp: TToolButton;
     procedure ListDblClick(Sender: TObject);
     procedure ListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
   private
@@ -35,7 +52,8 @@ type
     fMaxMessCnt: Integer;
     fProj: TCEProject;
     fDoc: TCESynMemo;
-    procedure filterMessages;
+    fCtxt: TCEAppMessageCtxt;
+    procedure filterMessages(aCtxt: TCEAppMessageCtxt);
     procedure clearOutOfRangeMessg;
     procedure actClearEdiExecute(Sender: TObject);
     procedure actClearAllExecute(Sender: TObject);
@@ -44,10 +62,11 @@ type
     procedure actSelAllExecute(Sender: TObject);
     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 selCtxtClick(Sender: TObject);
+    function iconIndex(aKind: TCEAppMessageKind): Integer;
     //
     procedure optset_MaxMessageCount(aReader: TReader);
     procedure optget_MaxMessageCount(awriter: TWriter);
@@ -58,12 +77,6 @@ type
     destructor destroy; override;
     //
     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);
     //
     procedure sesoptDeclareProperties(aFiler: TFiler); override;
     //
@@ -85,17 +98,15 @@ type
       aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
     procedure lmProcess(const aValue: TProcess; aData: Pointer;
       aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
-    //
+    procedure lmClearbyContext(aCtxt: TCEAppMessageCtxt);
-    procedure ClearAllMessages;
+    procedure lmClearbyData(aData: Pointer);
-    procedure ClearMessages(aCtxt: TMessageContext);
   end;
 
   TMessageKind = (msgkUnknown, msgkInfo, msgkHint, msgkWarn, msgkError);
 
-  function semanticMsgAna(const aMessg: string): TMessageKind;
+  function semanticMsgAna2(const aMessg: string): TCEAppMessageKind;
   function getLineFromDmdMessage(const aMessage: string): TPoint;
   function openFileFromDmdMessage(const aMessage: string): boolean;
-  function newMessageData: PMessageItemData;
 
 implementation
 {$R *.lfm}
@@ -107,6 +118,7 @@ uses
 constructor TCEMessagesWidget.create(aOwner: TComponent);
 begin
   fMaxMessCnt := 125;
+  fCtxt := amcAll;
   //
   fActClearAll := TAction.Create(self);
   fActClearAll.OnExecute := @actClearAllExecute;
@@ -129,6 +141,12 @@ begin
   List.PopupMenu := contextMenu;
   List.OnDeletion := @ListDeletion;
   //
+  btnSelProj.OnClick  := @selCtxtClick;
+  btnSelMisc.OnClick  := @selCtxtClick;
+  btnSelEdit.OnClick  := @selCtxtClick;
+  btnSelApp.OnClick   := @selCtxtClick;
+  btnSelAll.OnClick   := @selCtxtClick;
+  //
   EntitiesConnector.addObserver(self);
 end;
 
@@ -141,7 +159,7 @@ end;
 procedure TCEMessagesWidget.listDeletion(Sender: TObject; Node: TTreeNode);
 begin
   if node.Data <> nil then
-    Dispose( PMessageItemData(Node.Data));
+    Dispose( PMessageData(Node.Data));
 end;
 
 procedure TCEMessagesWidget.ListKeyDown(Sender: TObject; var Key: Word;
@@ -157,9 +175,34 @@ begin
       if List.Items[i].MultiSelected then
         List.Items.Delete(List.Items[i]);
     end
-    else ClearAllMessages;
+    else lmClearbyContext(amcAll);
   end;
 end;
+
+procedure TCEMessagesWidget.selCtxtClick(Sender: TObject);
+var
+  btn: TToolButton;
+  i: Integer;
+begin
+  if sender = nil then
+    exit;
+  //
+  fCtxt := amcAll;
+  btn := TToolButton(Sender);
+  for i := 0 to selCtxt.ButtonCount-1 do
+    selCtxt.Buttons[i].Down := selCtxt.Buttons[i] = btn;
+  if btn = btnSelAll  then
+    fCtxt := amcAll
+  else if btn = btnSelEdit then
+    fCtxt := amcEdit
+  else if btn = btnSelProj then
+    fCtxt := amcProj
+  else if btn = btnSelApp then
+    fCtxt := amcApp
+  else if btn = btnSelMisc then
+    fCtxt := amcMisc;
+  filterMessages(fCtxt);
+end;
 {$ENDREGION}
 
 {$REGION ICESessionOptionsObserver ------------------------------------------------------}
@@ -214,12 +257,12 @@ end;
 
 procedure TCEMessagesWidget.actClearAllExecute(Sender: TObject);
 begin
-  ClearAllMessages;
+  lmClearbyContext(amcAll);
 end;
 
 procedure TCEMessagesWidget.actClearEdiExecute(Sender: TObject);
 begin
-  ClearMessages(mcEditor);
+  lmClearbyData(@fDoc);
 end;
 
 procedure TCEMessagesWidget.actCopyMsgExecute(Sender: TObject);
@@ -269,21 +312,21 @@ end;
 procedure TCEMessagesWidget.projNew(const aProject: TCEProject);
 begin
   fProj := aProject;
-  filterMessages;
+  filterMessages(fCtxt);
 end;
 
 procedure TCEMessagesWidget.projClosing(const aProject: TCEProject);
 begin
   if fProj = aProject then
-    ClearMessages(mcProject);
+    lmClearByData(@fProj);
   fProj := nil;
-  filterMessages;
+  filterMessages(fCtxt);
 end;
 
 procedure TCEMessagesWidget.projFocused(const aProject: TCEProject);
 begin
   fProj := aProject;
-  filterMessages;
+  filterMessages(fCtxt);
 end;
 
 procedure TCEMessagesWidget.projChanged(const aProject: TCEProject);
@@ -295,21 +338,21 @@ end;
 procedure TCEMessagesWidget.docNew(const aDoc: TCESynMemo);
 begin
   fDoc := aDoc;
-  filterMessages;
+  filterMessages(fCtxt);
 end;
 
 procedure TCEMessagesWidget.docClosing(const aDoc: TCESynMemo);
 begin
   if aDoc <> fDoc then exit;
-  ClearMessages(mcEditor);
+  lmClearbyData(@fDoc);
   fDoc := nil;
-  filterMessages;
+  filterMessages(fCtxt);
 end;
 
 procedure TCEMessagesWidget.docFocused(const aDoc: TCESynMemo);
 begin
   fDoc := aDoc;
-  filterMessages;
+  filterMessages(fCtxt);
 end;
 
 procedure TCEMessagesWidget.docChanged(const aDoc: TCESynMemo);
@@ -318,17 +361,24 @@ begin
 end;
 {$ENDREGION}
 
-{$REGION ICELogMessageObserver ---------------------------------------------------}
+{$REGION ICELogMessageObserver -------------------------------------------------}
-
 procedure TCEMessagesWidget.lmStandard(const aValue: string; aData: Pointer;
   aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
+var
+  dt: PMessageData;
+   item: TTreeNode;
 begin
-    case aKInd of
+  if aKind = amkAuto then
-    amkBub: addCeBub(aValue);
+    aKind := semanticMsgAna2(aValue);
-    amkInf: addCeInf(aValue);
+  dt := new(PMessageData);
-    amkWarn:addCeWarn(aValue);
+  dt^.data := aData;
-    amkErr: addCeErr(aValue);
+  dt^.ctxt := aCtxt;
-  end;
+  item := List.Items.Add(nil, aValue);
+  item.Data := dt;
+  item.ImageIndex := iconIndex(aKind);
+  item.SelectedIndex := item.ImageIndex;
+  clearOutOfRangeMessg;
+  scrollToBack;
   Application.ProcessMessages;
 end;
 
@@ -338,11 +388,16 @@ begin
    if not (poUsePipes in aValue.Options) then
     exit;
    //
-  if aValue is TAsyncProcess then begin
+   aValue.Tag := (Byte(aCtxt) << 8) + Byte(aKind);
+   //
+  if (aValue is TAsyncProcess) then
+  begin
     TAsyncProcess(aValue).OnReadData := @processOutput;
     TAsyncProcess(aValue).OnTerminate := @processTerminate;
-  end else
+  end;
-    logProcessOutput(aValue);
+  // always process message: a TAsyncProcess may be already terminated.
+  logProcessOutput(aValue);
+  //
   Application.ProcessMessages;
 end;
 
@@ -365,38 +420,67 @@ begin
   try
     processOutputToStrings(aProcess, lst);
     for str in lst do
-      addCeBub(str);
+      // initial info should be in a TProcessMessage
+      lmStandard(str, nil, amcAll, amkBub);
   finally
     lst.Free;
+    Application.ProcessMessages;
+  end;
+end;
+
+procedure TCEMessagesWidget.lmClearByContext(aCtxt: TCEAppMessageCtxt);
+var
+  i: Integer;
+  msgdt: PMessageData;
+begin
+  if aCtxt = amcAll then
+  begin
+    List.Items.Clear;
+    exit;
+  end;
+  for i := List.Items.Count-1 downto 0 do
+  begin
+    msgdt := PMessageData(List.Items[i].Data);
+    if msgdt^.ctxt = aCtxt then
+      List.Items.Delete(List.Items[i]);
+  end;
+end;
+
+procedure TCEMessagesWidget.lmClearByData(aData: Pointer);
+var
+  i: Integer;
+  msgdt: PMessageData;
+begin
+  if aData = nil then
+    exit;
+  for i := List.Items.Count-1 downto 0 do
+  begin
+    msgdt := PMessageData(List.Items[i].Data);
+    if (msgdt^.data = aData) or (msgdt^.data = Pointer(aData^)) then
+      List.Items.Delete(List.Items[i]);
   end;
 end;
 {$ENDREGION}
 
 {$REGION Messages --------------------------------------------------------------}
+function TCEMessagesWidget.iconIndex(aKind: TCEAppMessageKind): Integer;
+begin
+  case aKind of
+    amkBub:  exit(0);
+    amkInf:  exit(1);
+    amkHint: exit(2);
+    amkWarn: exit(3);
+    amkErr:  exit(4);
+    else exit(0);
+  end;
+end;
+
 procedure TCEMessagesWidget.clearOutOfRangeMessg;
 begin
   while List.Items.Count > fMaxMessCnt do
     List.Items.Delete(List.Items.GetFirstNode);
 end;
 
-function newMessageData: PMessageItemData;
-begin
-  result := new(PMessageItemData);
-  result^.ctxt := mcUnknown;
-  result^.project := nil;
-  result^.editor := nil;
-  result^.position := point(0,0);
-end;
-
-function TCEMessagesWidget.newMessageItemData(aCtxt: TMessageContext): PMessageItemData;
-begin
-  result := new(PMessageItemData);
-  result^.ctxt := aCtxt;
-  result^.project := fProj;
-  result^.editor := fDoc;
-  result^.position := point(0,0);
-end;
-
 procedure TCEMessagesWidget.scrollToBack;
 begin
   if not Visible then exit;
@@ -405,159 +489,74 @@ begin
 end;
 
 procedure TCEMessagesWidget.ListDblClick(Sender: TObject);
-var
+//var
-  dat: PMessageItemData;
+  //dat: PMessageItemData;
 begin
-  if List.Selected = nil then exit;
+  //if List.Selected = nil then exit;
-  if List.Selected.Data = nil then exit;
+  //if List.Selected.Data = nil then exit;
-  //
+  ////
-  dat := PMessageItemData(List.Selected.Data);
+  //dat := PMessageItemData(List.Selected.Data);
-  if dat^.editor = nil then exit;
+  //if dat^.editor = nil then exit;
-  CEMainForm.openFile(dat^.editor.fileName);
+  //CEMainForm.openFile(dat^.editor.fileName);
-  dat^.editor.CaretXY := dat^.position;
+  //dat^.editor.CaretXY := dat^.position;
-  dat^.editor.SelectLine;
+  //dat^.editor.SelectLine;
 end;
 
-procedure TCEMessagesWidget.filterMessages;
+procedure TCEMessagesWidget.filterMessages(aCtxt: TCEAppMessageCtxt);
 var
+  msgdt: PMessageData;
   itm: TTreeNode;
-  dat: PMessageItemData;
   i: NativeInt;
 begin
   if updating then exit;
   for i := 0 to List.Items.Count-1 do
   begin
     itm := List.Items[i];
-    dat := PMessageItemData(itm.Data);
+    Itm.Visible := false;
-    case dat^.ctxt of
+    msgdt := PMessageData(itm.Data);
-      mcProject: itm.Visible := fProj = dat^.project;
+    if aCtxt = amcAll then
-      mcEditor: itm.Visible := fDoc = dat^.editor;
+    begin
-      else itm.Visible := true;
+      Itm.Visible := true;
+      continue;
+    end
+    else case msgdt^.ctxt of
+      // PMessageData.data can be either a reference or a pointer
+      amcEdit: itm.Visible := ((fDoc  = TCESynMemo(msgdt^.data)) or (fDoc  = TCESynMemo(msgdt^.data^)))
+        and (aCtxt = amcEdit);
+      amcProj: itm.Visible := ((fProj = TCEProject(msgdt^.data)) or (fProj = TCEProject(msgdt^.data^)))
+        and (aCtxt = amcProj);
+      amcApp:  itm.Visible := aCtxt = amcApp;
+      amcMisc: itm.Visible := aCtxt = amcMisc;
     end;
   end;
 end;
 
-procedure TCEMessagesWidget.ClearAllMessages;
+function semanticMsgAna2(const aMessg: string): TCEAppMessageKind;
-begin
-  List.Items.Clear;
-end;
-
-procedure TCEMessagesWidget.ClearMessages(aCtxt: TMessageContext);
-var
-  i: Integer;
-  dt: TMessageItemData;
-begin
-  for i := List.Items.Count-1 downto 0 do
-  begin
-    dt := PMessageItemData(List.Items[i].Data)^;
-    if dt.ctxt = aCtxt then case aCtxt of
-      mcEditor: if dt.editor = fDoc then List.Items.Delete(List.Items[i]);
-      mcProject: if dt.project = fProj then List.Items.Delete(List.Items[i]);
-      else List.Items.Delete(List.Items[i]);
-    end;
-  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;
-begin
-  item := List.Items.Add(nil, 'Coedit information: ' + aMsg);
-  item.Data := newMessageItemData(aCtxt);
-  item.ImageIndex := 1;
-  item.SelectedIndex := 1;
-  clearOutOfRangeMessg;
-  scrollToBack;
-end;
-
-procedure TCEMessagesWidget.addCeWarn(const aMsg: string; aCtxt: TMessageContext = mcUnknown);
-var
-  item: TTreeNode;
-begin
-  item := List.Items.Add(nil, 'Coedit warning: ' + aMsg);
-  item.Data := newMessageItemData(aCtxt);
-  item.ImageIndex := 3;
-  item.SelectedIndex := 3;
-  clearOutOfRangeMessg;
-  scrollToBack;
-end;
-
-procedure TCEMessagesWidget.addCeErr(const aMsg: string; aCtxt: TMessageContext = mcUnknown);
-var
-  item: TTreeNode;
-begin
-  item := List.Items.Add(nil, 'Coedit error: ' + aMsg);
-  item.Data := newMessageItemData(aCtxt);
-  item.ImageIndex := 4;
-  item.SelectedIndex := 4;
-  clearOutOfRangeMessg;
-  scrollToBack;
-end;
-
-procedure TCEMessagesWidget.addMessage(const aMsg: string; const aData: PMessageItemData);
-var
-  item: TTreeNode;
-  imgIx: Integer;
-begin
-  item := List.Items.Add(nil, aMsg);
-  item.Data := aData;
-  imgIx := Integer(semanticMsgAna(aMsg));
-  item.ImageIndex := imgIx;
-  item.SelectedIndex := imgIx;
-  clearOutOfRangeMessg;
-end;
-
-procedure TCEMessagesWidget.addMessage(const aMsg: string; aCtxt: TMessageContext = mcUnknown);
-var
-  item: TTreeNode;
-  imgIx: Integer;
-begin
-  item := List.Items.Add(nil, aMsg);
-  item.Data := newMessageItemData(aCtxt);
-  imgIx := Integer(semanticMsgAna(aMsg));
-  item.ImageIndex := imgIx;
-  item.SelectedIndex := imgIx;
-  clearOutOfRangeMessg;
-end;
-
-function semanticMsgAna(const aMessg: string): TMessageKind;
 var
   pos: Nativeint;
   idt: string;
-function checkIdent: TMessageKind;
+function checkIdent: TCEAppMessageKind;
 begin
   case idt of
     'ERROR', 'error', 'Error', 'Invalid', 'invalid',
     'exception', 'Exception', 'illegal', 'Illegal',
     'fatal', 'Fatal', 'Critical', 'critical':
-      exit(msgkError);
+      exit(amkErr);
     'Warning', 'warning', 'caution', 'Caution':
-      exit(msgkWarn);
+      exit(amkWarn);
     'Hint', 'hint', 'Tip', 'tip', 'advice', 'Advice',
     'suggestion', 'Suggestion':
-      exit(msgkHint);
+      exit(amkHint);
     'Information', 'information':
-      exit(msgkInfo);
+      exit(amkInf);
     else
-      exit(msgkUnknown);
+      exit(amkBub);
   end;
 end;
 begin
   idt := '';
   pos := 1;
-  result := msgkUnknown;
+  result := amkBub;
   while(true) do
   begin
     if pos > length(aMessg) then exit;
@@ -565,7 +564,7 @@ begin
     begin
       Inc(pos);
       result := checkIdent;
-      if result <> msgkUnknown then exit;
+      if result <> amkBub then exit;
       idt := '';
       continue;
     end;
@@ -573,7 +572,7 @@ begin
     begin
       Inc(pos);
       result := checkIdent;
-      if result <> msgkUnknown then exit;
+      if result <> amkBub then exit;
       idt := '';
       continue;
     end;

src/ce_miniexplorer.pas

@@ -259,7 +259,7 @@ begin
   if not fileExists(fname) then exit;
   if not shellOpen(fname) then subjLmStandard(fLogMessager,
     (format('the shell failed to open "%s"', [shortenPath(fname, 25)])),
-    nil, amcTool, amkErr);
+    nil, amcMisc, amkErr);
 end;
 
 {$ENDREGION}