implements #24, demangle messages

problem: this doesn't work on types, ddemangle does not call the function to do that
This commit is contained in:
Basile Burg 2015-09-14 04:25:56 +02:00
parent fd5e3219c3
commit 44b48164ae
1 changed files with 114 additions and 10 deletions

View File

@ -7,8 +7,8 @@ interface
uses uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls,
lcltype, ce_widget, ActnList, Menus, clipbrd, AnchorDocking, TreeFilterEdit, lcltype, ce_widget, ActnList, Menus, clipbrd, AnchorDocking, TreeFilterEdit,
Buttons, math,ce_writableComponent, ce_common, ce_synmemo, GraphType, Buttons, math, process, ce_writableComponent, ce_common, ce_synmemo, GraphType,
ce_dlangutils, ce_interfaces, ce_observer, ce_symstring; ce_dlangutils, ce_interfaces, ce_observer, ce_symstring, ce_processes;
type type
@ -19,6 +19,7 @@ type
TMessageData = record TMessageData = record
ctxt: TCEAppMessageCtxt; ctxt: TCEAppMessageCtxt;
data: Pointer; data: Pointer;
demangled: boolean;
end; end;
TCEMessagesOptions = class(TWritableLfmTextComponent) TCEMessagesOptions = class(TWritableLfmTextComponent)
@ -27,6 +28,7 @@ type
fMaxCount: Integer; fMaxCount: Integer;
fAutoSelect: boolean; fAutoSelect: boolean;
fSingleClick: boolean; fSingleClick: boolean;
fDemangle: boolean;
fFont: TFont; fFont: TFont;
fMsgColors: array[TCEAppMessageKind] of TColor; fMsgColors: array[TCEAppMessageKind] of TColor;
procedure setFont(aValue: TFont); procedure setFont(aValue: TFont);
@ -41,6 +43,7 @@ type
property colorHint: TColor read fMsgColors[amkHint] write fMsgColors[amkHint]; property colorHint: TColor read fMsgColors[amkHint] write fMsgColors[amkHint];
property colorWarning: TColor read fMsgColors[amkWarn] write fMsgColors[amkWarn]; property colorWarning: TColor read fMsgColors[amkWarn] write fMsgColors[amkWarn];
property colorError: TColor read fMsgColors[amkErr] write fMsgColors[amkErr]; property colorError: TColor read fMsgColors[amkErr] write fMsgColors[amkErr];
property demangle: boolean read fDemangle write fDemangle default false;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor destroy; override; destructor destroy; override;
@ -75,6 +78,7 @@ type
State: TCustomDrawState; var DefaultDraw: Boolean); State: TCustomDrawState; var DefaultDraw: Boolean);
procedure ListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure ListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
private private
fDemangle: boolean;
fMsgColors: array[TCEAppMessageKind] of TColor; fMsgColors: array[TCEAppMessageKind] of TColor;
fActAutoSel: TAction; fActAutoSel: TAction;
fActClearAll: TAction; fActClearAll: TAction;
@ -89,9 +93,13 @@ type
fAutoSelect: boolean; fAutoSelect: boolean;
fSingleClick: boolean; fSingleClick: boolean;
fastDisplay: boolean; fastDisplay: boolean;
fDemangler: TCEProcess;
fOptions: TCEMessagesOptions; fOptions: TCEMessagesOptions;
fOptionsBackup: TCEMessagesOptions; fOptionsBackup: TCEMessagesOptions;
fBtns: array[TCEAppMessageCtxt] of TToolButton; fBtns: array[TCEAppMessageCtxt] of TToolButton;
fToDemangle: TStringList;
fToDemangleObjs: TFPList;
procedure demanglerOutput(sender: TObject);
procedure filterMessages(aCtxt: TCEAppMessageCtxt); procedure filterMessages(aCtxt: TCEAppMessageCtxt);
procedure clearOutOfRangeMessg; procedure clearOutOfRangeMessg;
procedure actAutoSelExecute(Sender: TObject); procedure actAutoSelExecute(Sender: TObject);
@ -103,10 +111,13 @@ type
procedure setMaxMessageCount(aValue: Integer); procedure setMaxMessageCount(aValue: Integer);
procedure setAutoSelectCategory(aValue: boolean); procedure setAutoSelectCategory(aValue: boolean);
procedure setSingleMessageClick(aValue: boolean); procedure setSingleMessageClick(aValue: boolean);
procedure setDemangle(aValue: boolean);
procedure listDeletion(Sender: TObject; Node: TTreeNode); procedure listDeletion(Sender: TObject; Node: TTreeNode);
procedure selCtxtClick(Sender: TObject); procedure selCtxtClick(Sender: TObject);
function iconIndex(aKind: TCEAppMessageKind): Integer; function iconIndex(aKind: TCEAppMessageKind): Integer;
procedure handleMessageClick(Sender: TObject); procedure handleMessageClick(Sender: TObject);
procedure callDemangler;
procedure freeMangler;
// //
procedure setColorError(aValue: TColor); procedure setColorError(aValue: TColor);
procedure setColorInfo(aValue: TColor); procedure setColorInfo(aValue: TColor);
@ -146,6 +157,7 @@ type
property maxMessageCount: Integer read fMaxMessCnt write setMaxMessageCount; property maxMessageCount: Integer read fMaxMessCnt write setMaxMessageCount;
property autoSelectCategory: boolean read fAutoSelect write setAutoSelectCategory; property autoSelectCategory: boolean read fAutoSelect write setAutoSelectCategory;
property singleMessageClick: boolean read fSingleClick write setSingleMessageClick; property singleMessageClick: boolean read fSingleClick write setSingleMessageClick;
property demangle: boolean read fDemangle write setDemangle;
// //
property colorBuble: TColor read fMsgColors[amkBub] write setColorBuble; property colorBuble: TColor read fMsgColors[amkBub] write setColorBuble;
property colorInfo: TColor read fMsgColors[amkInf] write setColorInfo; property colorInfo: TColor read fMsgColors[amkInf] write setColorInfo;
@ -200,6 +212,7 @@ begin
fAutoSelect := opts.fAutoSelect; fAutoSelect := opts.fAutoSelect;
fSingleClick := opts.fSingleClick; fSingleClick := opts.fSingleClick;
fFastDisplay := opts.fFastDisplay; fFastDisplay := opts.fFastDisplay;
fDemangle := opts.fDemangle;
fMsgColors := opts.fMsgColors; fMsgColors := opts.fMsgColors;
fFont.EndUpdate; fFont.EndUpdate;
end end
@ -212,6 +225,7 @@ begin
fSingleClick := widg.fSingleClick; fSingleClick := widg.fSingleClick;
fFastDisplay := widg.fastDisplay; fFastDisplay := widg.fastDisplay;
fMsgColors := widg.fMsgColors; fMsgColors := widg.fMsgColors;
fDemangle := widg.fDemangle;
end end
else inherited; else inherited;
end; end;
@ -229,6 +243,7 @@ begin
widg.singleMessageClick := fSingleClick; widg.singleMessageClick := fSingleClick;
widg.fastDisplay:= fFastDisplay; widg.fastDisplay:= fFastDisplay;
widg.fMsgColors := fMsgColors; widg.fMsgColors := fMsgColors;
widg.Demangle := fDemangle;
end end
else inherited; else inherited;
end; end;
@ -308,21 +323,32 @@ begin
fOptions.AssignTo(self); fOptions.AssignTo(self);
end; end;
// //
fToDemangle := TStringList.Create;
fToDemangleObjs:= TFPList.Create;
//
EntitiesConnector.addObserver(self); EntitiesConnector.addObserver(self);
EntitiesConnector.addSingleService(self); EntitiesConnector.addSingleService(self);
end; end;
destructor TCEMessagesWidget.destroy; destructor TCEMessagesWidget.destroy;
begin begin
fToDemangle.Free;
fToDemangleObjs.Free;
freeMangler;
fOptions.saveToFile(getCoeditDocPath + optname); fOptions.saveToFile(getCoeditDocPath + optname);
EntitiesConnector.removeObserver(self); EntitiesConnector.removeObserver(self);
Inherited; inherited;
end; end;
procedure TCEMessagesWidget.listDeletion(Sender: TObject; Node: TTreeNode); procedure TCEMessagesWidget.listDeletion(Sender: TObject; Node: TTreeNode);
var
i: integer;
begin begin
if node.Data <> nil then if node.Data <> nil then
Dispose(PMessageData(Node.Data)); Dispose(PMessageData(Node.Data));
i := fToDemangleObjs.IndexOf(node);
if i <> -1 then
fToDemangleObjs.Items[i] := nil;
end; end;
procedure TCEMessagesWidget.ListKeyDown(Sender: TObject; var Key: Word; procedure TCEMessagesWidget.ListKeyDown(Sender: TObject; var Key: Word;
@ -402,6 +428,14 @@ begin
end; end;
end; end;
procedure TCEMessagesWidget.setDemangle(aValue: boolean);
begin
if fDemangle = aValue then exit;
fDemangle := aValue;
if fDemangle then
IncLoopUpdate;
end;
procedure TCEMessagesWidget.setColorError(aValue: TColor); procedure TCEMessagesWidget.setColorError(aValue: TColor);
begin begin
fMsgColors[amkErr] := max(aValue, minColor); fMsgColors[amkErr] := max(aValue, minColor);
@ -649,23 +683,40 @@ begin
exit('ICEMessagesDisplay'); exit('ICEMessagesDisplay');
end; end;
procedure TCEMessagesWidget.demanglerOutput(sender: TObject);
var
itm: TTreeNode;
i: integer;
begin
fToDemangle.LoadFromStream(fDemangler.OutputStack);
for i := 0 to fToDemangleObjs.Count -1 do
begin
itm := TTreeNode(fToDemangleObjs.Items[i]);
if itm = nil then continue;
itm.Text := fToDemangle.Strings[i];
end;
end;
procedure TCEMessagesWidget.message(const aValue: string; aData: Pointer; procedure TCEMessagesWidget.message(const aValue: string; aData: Pointer;
aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind); aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
var var
dt: PMessageData; dt: PMessageData;
item: TTreeNode; item: TTreeNode;
msg: string;
begin begin
showWidget; showWidget;
msg := aValue;
if aKind = amkAuto then if aKind = amkAuto then
aKind := guessMessageKind(aValue); aKind := guessMessageKind(msg);
dt := new(PMessageData); dt := new(PMessageData);
dt^.data := aData; dt^.data := aData;
dt^.ctxt := aCtxt; dt^.ctxt := aCtxt;
dt^.demangled:=false;
if fAutoSelect then if fCtxt <> aCtxt then if fAutoSelect then if fCtxt <> aCtxt then
fBtns[aCtxt].Click; fBtns[aCtxt].Click;
if fastDisplay then if fastDisplay or fDemangle then
IncLoopUpdate; IncLoopUpdate;
item := List.Items.Add(nil, aValue); item := List.Items.Add(nil, msg);
item.Data := dt; item.Data := dt;
item.ImageIndex := iconIndex(aKind); item.ImageIndex := iconIndex(aKind);
item.SelectedIndex := item.ImageIndex; item.SelectedIndex := item.ImageIndex;
@ -715,13 +766,66 @@ end;
{$ENDREGION} {$ENDREGION}
{$REGION Messages --------------------------------------------------------------} {$REGION Messages --------------------------------------------------------------}
procedure TCEMessagesWidget.callDemangler;
var
dat: PMessageData;
i: integer;
str: string;
begin
freeMangler;
fDemangler := TCEProcess.Create(nil);
fDemangler.Executable := 'ddemangle' + exeExt;
fDemangler.OnTerminate:= @demanglerOutput;
fDemangler.Options:= fDemangler.Options + [poUsePipes];
fDemangler.ShowWindow:= swoHIDE;
if exeInSysPath(fDemangler.Executable) then
begin
fToDemangle.Clear;
fToDemangleObjs.Clear;
for i := 0 to list.Items.Count-1 do
begin
dat := PMessageData(list.Items.Item[i].Data);
if dat^.demangled then continue;
dat^.demangled := true;
str := list.Items.Item[i].Text;
fToDemangleObjs.add(list.Items.Item[i]);
fToDemangle.Add(str);
end;
if fToDemangle.Count > 0 then
begin
fDemangler.Execute;
for i := 0 to fToDemangle.Count-1 do
begin
str := fToDemangle.Strings[i] + LineEnding;
fDemangler.Input.Write(str[1], length(str));
end;
fDemangler.CloseInput;
end;
end;
end;
procedure TCEMessagesWidget.freeMangler;
begin
if fDemangler <> nil then
begin
if fDemangler.Active then
fDemangler.Terminate(0);
fDemangler.Free;
fDemangler := nil;
end;
end;
procedure TCEMessagesWidget.updateLoop; procedure TCEMessagesWidget.updateLoop;
begin
if fastDisplay then
begin begin
clearOutOfRangeMessg; clearOutOfRangeMessg;
scrollToBack; scrollToBack;
List.Update; List.Update;
filterMessages(fCtxt); filterMessages(fCtxt);
end; end;
callDemangler;
end;
function TCEMessagesWidget.iconIndex(aKind: TCEAppMessageKind): Integer; function TCEMessagesWidget.iconIndex(aKind: TCEAppMessageKind): Integer;
begin begin