From de0022a61f4bdd3f09b59ad3ecf1d52b119eb90b Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Sat, 8 Nov 2014 06:26:56 +0100 Subject: [PATCH] messages rewrite using internal observer system 3 --- src/ce_customtools.pas | 2 +- src/ce_interfaces.pas | 28 ++- src/ce_main.pas | 131 +++++++------- src/ce_messages.lfm | 99 +++++++++-- src/ce_messages.pas | 367 ++++++++++++++++++++-------------------- src/ce_miniexplorer.pas | 2 +- 6 files changed, 363 insertions(+), 266 deletions(-) diff --git a/src/ce_customtools.pas b/src/ce_customtools.pas index e29d0f8c..45042fed 100644 --- a/src/ce_customtools.pas +++ b/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; diff --git a/src/ce_interfaces.pas b/src/ce_interfaces.pas index 245a9652..f1742ac0 100644 --- a/src/ce_interfaces.pas +++ b/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. diff --git a/src/ce_main.pas b/src/ce_main.pas index 07615368..6706b9e3 100644 --- a/src/ce_main.pas +++ b/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 - ce_common.dlgOkError(E.Message) - else fMesgWidg.addCeErr(E.Message); + //if fMesgWidg = nil then + //ce_common.dlgOkError(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); -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.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 @@ -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); - fMesgWidg.addCeInf('compiling ' + editor.fileName, mcEditor); + subjLmClearByData(fLogMessager, editor); + 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); - fMesgWidg.addCeInf(editor.fileName + ' successfully compiled', mcEditor ); + subjLmStandard(fLogMessager, shortenPath(editor.fileName,25) + + ' 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); - fMesgWidg.addCeErr(editor.fileName + ' has not been compiled', mcEditor ); + subjLmStandard(fLogMessager, shortenPath(editor.fileName,25) + + ' has not been compiled', editor, amcEdit, amkErr); end; finally diff --git a/src/ce_messages.lfm b/src/ce_messages.lfm index 707cfc35..efd8b10d 100644 --- a/src/ce_messages.lfm +++ b/src/ce_messages.lfm @@ -1,27 +1,27 @@ inherited CEMessagesWidget: TCEMessagesWidget - Left = 812 + Left = 1135 Height = 172 - Top = 258 - Width = 744 + Top = 183 + 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 - Top = 2 - Width = 740 + Height = 140 + Top = 30 + 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 - top = 8 + left = 16 + top = 40 end object imgList: TImageList[2] - left = 40 - top = 8 + left = 56 + top = 40 Bitmap = { 4C69050000001000000010000000CF986200D1996200D1996234D0965DBCCF94 5BFFCE945AFFCE935AFFCE935AFFCE935AFFCE935AFFCE945AFFCF945BFFD096 diff --git a/src/ce_messages.pas b/src/ce_messages.pas index 95762f62..091c47e4 100644 --- a/src/ce_messages.pas +++ b/src/ce_messages.pas @@ -11,19 +11,36 @@ uses type - TMessageContext = (mcUnknown, mcProject, mcEditor, mcApplication); - PMessageItemData = ^TMessageItemData; - TMessageItemData = record - ctxt: TMessageContext; - editor: TCESynMemo; - project: TCEProject; - position: TPoint; + 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; + 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 ClearAllMessages; - procedure ClearMessages(aCtxt: TMessageContext); + procedure lmClearbyContext(aCtxt: TCEAppMessageCtxt); + procedure lmClearbyData(aData: Pointer); 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 - amkBub: addCeBub(aValue); - amkInf: addCeInf(aValue); - amkWarn:addCeWarn(aValue); - amkErr: addCeErr(aValue); - end; + if aKind = amkAuto then + aKind := semanticMsgAna2(aValue); + dt := new(PMessageData); + dt^.data := aData; + dt^.ctxt := aCtxt; + 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 - logProcessOutput(aValue); + end; + // 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 - dat: PMessageItemData; +//var + //dat: PMessageItemData; begin - if List.Selected = nil then exit; - if List.Selected.Data = nil then exit; - // - dat := PMessageItemData(List.Selected.Data); - if dat^.editor = nil then exit; - CEMainForm.openFile(dat^.editor.fileName); - dat^.editor.CaretXY := dat^.position; - dat^.editor.SelectLine; + //if List.Selected = nil then exit; + //if List.Selected.Data = nil then exit; + //// + //dat := PMessageItemData(List.Selected.Data); + //if dat^.editor = nil then exit; + //CEMainForm.openFile(dat^.editor.fileName); + //dat^.editor.CaretXY := dat^.position; + //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); - case dat^.ctxt of - mcProject: itm.Visible := fProj = dat^.project; - mcEditor: itm.Visible := fDoc = dat^.editor; - else itm.Visible := true; + Itm.Visible := false; + msgdt := PMessageData(itm.Data); + if aCtxt = amcAll then + begin + 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; -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; +function semanticMsgAna2(const aMessg: string): TCEAppMessageKind; 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; diff --git a/src/ce_miniexplorer.pas b/src/ce_miniexplorer.pas index e29231a5..af277632 100644 --- a/src/ce_miniexplorer.pas +++ b/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}