unit u_messages; {$I u_defines.inc} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls, EditBtn, lcltype, u_widget, ActnList, Menus, clipbrd, AnchorDocking, math, TreeFilterEdit, Buttons, GraphType, fgl, strutils, LazFileUtils, u_ddemangle, u_writableComponent, u_common, u_synmemo, u_interfaces, u_observer, u_sharedres, u_stringrange, u_dsgncontrols; type TEditorMessagePos = class(specialize TFPGMap); (** * the struct linked to a log message. allow to be filtered. *) PMessageData = ^TMessageData; TMessageData = record ctxt: TAppMessageCtxt; data: Pointer; end; TMessagesOptions = class(TWritableLfmTextComponent) private fbackTickHighlight: boolean; fFastDisplay: boolean; fMaxCount: integer; fAutoSelect: boolean; fSingleClick: boolean; fAutoDemangle: boolean; fAlwaysFilter: boolean; fMaxLineLength: integer; fFont: TFont; fMsgColors: array[TAppMessageKind] of TColor; fHighlightColor: TColor; procedure setFont(value: TFont); published property alwaysFilter: boolean read fAlwaysFilter write fAlwaysFilter; property fastDisplay: boolean read fFastDisplay write fFastDisplay; property maxMessageCount: integer read fMaxCount write fMaxCount; property maxLineLength: integer read fMaxLineLength write fMaxLineLength default 4096; property autoSelect: boolean read fAutoSelect write fAutoSelect; property autoDemangle: boolean read fAutoDemangle write fAutoDemangle; property singleMessageClick: boolean read fSingleClick write fSingleClick; property font: TFont read fFont write setFont; property colorBuble: TColor read fMsgColors[amkBub] write fMsgColors[amkBub]; property colorInfo: TColor read fMsgColors[amkInf] write fMsgColors[amkInf]; property colorHint: TColor read fMsgColors[amkHint] write fMsgColors[amkHint]; property colorWarning: TColor read fMsgColors[amkWarn] write fMsgColors[amkWarn]; property colorError: TColor read fMsgColors[amkErr] write fMsgColors[amkErr]; property colorHighlight: TColor read fHighlightColor write fHighlightColor; property backticksHighlight: boolean read fbackTickHighlight write fbackTickHighlight default true; public constructor Create(AOwner: TComponent); override; destructor destroy; override; procedure assign(source: TPersistent); override; procedure AssignTo(target: TPersistent); override; end; // gives access to protected fields that should be actually public // (scroll position needed for custom draw !) TTreeHack = class(TTreeView) end; { TMessagesWidget } TMessagesWidget = class(TDexedWidget, IEditableOptions, IDocumentObserver, IProjectObserver, IMessagesDisplay) btnClearCat: TDexedToolButton; sepCat: TDexedToolButton; btnSelAll: TDexedToolButton; btnSelApp: TDexedToolButton; btnSelEdit: TDexedToolButton; btnSelMisc: TDexedToolButton; btnSelProj: TDexedToolButton; sep: TDexedToolButton; button2: TDexedToolButton; button4: TDexedToolButton; button6: TDexedToolButton; button8: TDexedToolButton; List: TTreeView; TreeFilterEdit1: TTreeFilterEdit; procedure ListCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); procedure ListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure toolbarResize(Sender: TObject); procedure TreeFilterEdit1AfterFilter(Sender: TObject); procedure TreeFilterEdit1ButtonClick(Sender: TObject); private fImages: TImageList; fEditorMessagePos: TEditorMessagePos; fMsgColors: array[TAppMessageKind] of TColor; fProjCompile: boolean; fActAutoSel: TAction; fActClearAll: TAction; fActClearCurCat: TAction; fActSaveMsg: TAction; fActCopyMsg: TAction; fActSelAll: TAction; fActDemangle: TAction; fMaxMessCnt: Integer; fAlwaysFilter: boolean; fProj: ICommonProject; fDoc: TDexedMemo; fCtxt: TAppMessageCtxt; fAutoSelect: boolean; fAutoDemangle: boolean; fSingleClick: boolean; fastDisplay: boolean; fOptions: TMessagesOptions; fOptionsBackup: TMessagesOptions; fBtns: array[TAppMessageCtxt] of TToolButton; fFiltering: boolean; fMustScrollToBack: boolean; fJustChangedContext: boolean; function itemShouldBeVisible(item: TTreeNode; aCtxt: TAppMessageCtxt): boolean; procedure filterMessages(aCtxt: TAppMessageCtxt); procedure clearOutOfRangeMessg; procedure actDemangleExecute(Sender: TObject); procedure actAutoSelExecute(Sender: TObject); procedure actClearCurCatExecute(Sender: TObject); procedure actClearAllExecute(Sender: TObject); procedure actSaveMsgExecute(Sender: TObject); procedure actCopyMsgExecute(Sender: TObject); procedure actSelAllExecute(Sender: TObject); procedure setMaxMessageCount(value: Integer); procedure setAutoSelectCategory(value: boolean); procedure setSingleMessageClick(value: boolean); procedure listDeletion(Sender: TObject; Node: TTreeNode); procedure selCtxtClick(Sender: TObject); function iconIndex(aKind: TAppMessageKind): Integer; procedure handleMessageClick(Sender: TObject); // procedure setColorError(value: TColor); procedure setColorInfo(value: TColor); procedure setColorHint(value: TColor); procedure setColorBuble(value: TColor); procedure setColorWarning(value: TColor); // procedure projNew(project: ICommonProject); procedure projClosing(project: ICommonProject); procedure projFocused(project: ICommonProject); procedure projChanged(project: ICommonProject); procedure projCompiling(project: ICommonProject); procedure projCompiled(project: ICommonProject; success: boolean); // procedure docNew(document: TDexedMemo); procedure docClosing(document: TDexedMemo); procedure docFocused(document: TDexedMemo); procedure docChanged(document: TDexedMemo); // function optionedWantCategory(): string; function optionedWantEditorKind: TOptionEditorKind; function optionedWantContainer: TPersistent; procedure optionedEvent(event: TOptionEditorEvent); function optionedOptionsModified: boolean; // function openFileFromDmdMessage(const aMessage: string): boolean; function getLineFromMessage(const aMessage: string): TPoint; function guessMessageKind(const aMessg: string): TAppMessageKind; // function singleServiceName: string; procedure message(const value: string; aData: Pointer; aCtxt: TAppMessageCtxt; aKind: TAppMessageKind); procedure beginMessageCall(); procedure endMessageCall(); procedure clearbyContext(aCtxt: TAppMessageCtxt); procedure clearbyData(data: Pointer); procedure scrollToBack; procedure checkIfMustScrollToBack(); protected procedure setToolBarFlat(value: boolean); override; procedure updateLoop; override; // function contextName: string; override; function contextActionCount: integer; override; function contextAction(index: integer): TAction; override; // property maxMessageCount: Integer read fMaxMessCnt write setMaxMessageCount; property autoSelectCategory: boolean read fAutoSelect write setAutoSelectCategory; property autoDEmangle: boolean read fAutoDemangle write fAutoDemangle; property singleMessageClick: boolean read fSingleClick write setSingleMessageClick; // property colorBuble: TColor read fMsgColors[amkBub] write setColorBuble; property colorInfo: TColor read fMsgColors[amkInf] write setColorInfo; property colorHint: TColor read fMsgColors[amkHint] write setColorHint; property colorWarning: TColor read fMsgColors[amkWarn] write setColorWarning; property colorError: TColor read fMsgColors[amkErr] write setColorError; public constructor create(aOwner: TComponent); override; destructor destroy; override; end; // Maps an identifier to a message kind type messageSemantic = record private { rendered on 2017-Jan-19 21:11:15.6560057 by IsItThere. - PRNG seed: 0 - map length: 64 - case sensitive: true } const fWords: array [0..63] of string = ('caution', '', '', '', 'Fatal', 'Critical', 'Error', 'Advice', 'Warn', '', '', 'advice', '', 'warning', '', 'information', '', '', '', 'Exception', '', '', 'illegal', '', '', 'Hint', 'errorlevel', 'Warning', 'critical', 'Deprecated', 'Invalid', 'fatal', '', 'Deprecation', 'hint', '', '', 'error', '', '', '', 'Caution', 'Tip', '', 'deprecated', '', '', 'Suggestion', 'deprecation', '', 'exception', 'ERROR', 'Information', '', '', '', 'suggestion', 'invalid', 'warn', 'Illegal', '', '', '', 'tip'); const fFilled: array [0..63] of boolean = (true, false, false, false, true, true, true, true, true, false, false, true, false, true, false, true, false, false, false, true, false, false, true, false, false, true, true, true, true, true, true, true, false, true, true, false, false, true, false, false, false, true, true, false, true, false, false, true, true, false, true, true, true, false, false, false, true, true, true, true, false, false, false, true); const fMap: array [0..63] of TAppMessageKind = ( amkWarn, amkBub, amkBub, amkBub, amkErr, amkErr, amkErr, amkHint, amkWarn, amkBub, amkBub, amkHint, amkBub, amkWarn, amkBub, amkInf, amkBub, amkBub, amkBub, amkErr, amkBub, amkBub, amkErr, amkBub, amkBub, amkHint, amkErr, amkWarn, amkErr, amkWarn, amkErr, amkErr, amkBub, amkWarn, amkHint, amkBub, amkBub, amkErr, amkBub, amkBub, amkBub, amkWarn, amkHint, amkBub, amkWarn, amkBub, amkBub, amkHint, amkWarn, amkBub, amkErr, amkErr, amkInf, amkBub, amkBub, amkBub, amkHint, amkErr, amkWarn, amkErr, amkBub, amkBub, amkBub, amkHint); const fCoefficients: array [0..255] of Byte = (151, 145, 214, 156, 15, 232, 156, 185, 180, 64, 178, 95, 6, 249, 69, 68, 240, 111, 93, 41, 229, 240, 146, 62, 148, 157, 106, 190, 120, 112, 104, 207, 85, 123, 228, 254, 43, 2, 236, 108, 39, 221, 41, 251, 144, 192, 247, 101, 210, 134, 105, 39, 208, 115, 116, 65, 209, 36, 237, 87, 195, 162, 142, 33, 203, 95, 12, 200, 124, 111, 9, 145, 187, 238, 173, 155, 214, 127, 229, 197, 232, 87, 213, 92, 39, 25, 218, 24, 193, 223, 45, 35, 157, 4, 34, 244, 154, 99, 21, 95, 203, 14, 100, 113, 68, 201, 199, 174, 249, 30, 153, 251, 122, 129, 244, 229, 188, 101, 103, 138, 164, 136, 188, 209, 164, 192, 76, 159, 40, 182, 137, 202, 107, 115, 9, 23, 14, 166, 47, 71, 243, 156, 148, 176, 187, 247, 143, 124, 180, 14, 250, 157, 212, 18, 151, 246, 174, 222, 41, 114, 148, 24, 34, 97, 116, 37, 173, 30, 177, 20, 55, 18, 15, 149, 94, 129, 87, 72, 25, 3, 82, 200, 198, 214, 49, 228, 10, 39, 191, 83, 128, 30, 117, 209, 216, 152, 89, 237, 253, 24, 173, 116, 65, 64, 55, 222, 210, 243, 140, 82, 219, 8, 35, 13, 123, 43, 15, 72, 174, 28, 10, 242, 74, 136, 18, 198, 247, 240, 196, 146, 49, 39, 175, 186, 38, 8, 110, 101, 179, 242, 152, 251, 227, 60, 25, 31, 123, 80, 149, 187, 67, 157, 120, 84, 83, 192); class function hash(const w: string): Word; static; public class function getType(const w: string): TAppMessageKind; static; end; implementation {$R *.lfm} const optname = 'messages.txt'; minColor = $232323; {$REGION TMessagesOptions ----------------------------------------------------} constructor TMessagesOptions.Create(AOwner: TComponent); begin inherited; fFont := TFont.Create; fFont.Style := [fsBold]; fbackTickHighlight := true; {$IFDEF WINDOWS} fFont.name := 'Consolas'; {$ENDIF} fFont.Size := ScaleY(11,96); fAutoSelect :=true; fMaxCount := 1000; fMaxLineLength:= 4096; fMsgColors[amkBub] := $FCE7D2; fMsgColors[amkWarn]:= $B3FFFF; fMsgColors[amkErr] := $BDBDFF; fMsgColors[amkInf] := $FFD0A8; fMsgColors[amkHint]:= $C2FFC2; fHighlightColor := $F7F7F7; end; destructor TMessagesOptions.destroy; begin fFont.Free; inherited; end; procedure TMessagesOptions.setFont(value: TFont); begin fFont.Assign(value); end; procedure TMessagesOptions.assign(source: TPersistent); var widg : TMessagesWidget; opts : TMessagesOptions; begin if source is TMessagesOptions then begin opts := TMessagesOptions(source); fFont.BeginUpdate; fFont.Assign(opts.font); fMaxCount := opts.fMaxCount; fAutoSelect := opts.fAutoSelect; fAutoDemangle:= opts.fAutoDemangle; fSingleClick := opts.fSingleClick; fFastDisplay := opts.fFastDisplay; fMsgColors := opts.fMsgColors; fAlwaysFilter := opts.fAlwaysFilter; fFont.EndUpdate; end else if source is TMessagesWidget then begin widg := TMessagesWidget(source); fFont.Assign(widg.List.Font); fMaxCount := widg.fMaxMessCnt; fAutoSelect := widg.fAutoSelect; fSingleClick := widg.fSingleClick; fFastDisplay := widg.fastDisplay; fMsgColors := widg.fMsgColors; fAutoDemangle:= widg.fAutoDemangle; fAlwaysFilter:=widg.fAlwaysFilter; end else inherited; end; procedure TMessagesOptions.AssignTo(target: TPersistent); var widg : TMessagesWidget; begin if target is TMessagesWidget then begin widg := TMessagesWidget(target); widg.List.Font.Assign(fFont); widg.maxMessageCount := fMaxCount; widg.autoSelectCategory := fAutoSelect; widg.singleMessageClick := fSingleClick; widg.fastDisplay:= fFastDisplay; widg.fMsgColors := fMsgColors; widg.fAutoDemangle:=fAutoDemangle; widg.fAlwaysFilter:=fAlwaysFilter; if fFastDisplay then widg.timedUpdateKind := tukLoop else widg.timedUpdateKind := tukNone; end else inherited; end; {$ENDREGION} {$REGION Standard Comp/Obj------------------------------------------------------} constructor TMessagesWidget.create(aOwner: TComponent); var fname: string; begin fMaxMessCnt := 500; fAutoSelect := true; fCtxt := amcAll; fActAutoSel := TAction.Create(self); fActAutoSel.Caption := 'Auto select message category'; fActAutoSel.AutoCheck := true; fActAutoSel.OnExecute := @actAutoSelExecute; fActClearAll := TAction.Create(self); fActClearAll.OnExecute := @actClearAllExecute; fActClearAll.caption := 'Clear all messages'; fActClearCurCat := TAction.Create(self); fActClearCurCat.OnExecute := @actClearCurCatExecute; fActClearCurCat.caption := 'Clear filtered messages'; fActCopyMsg := TAction.Create(self); fActCopyMsg.OnExecute := @actCopyMsgExecute; fActCopyMsg.Caption := 'Copy message(s)'; fActSelAll := TAction.Create(self); fActSelAll.OnExecute := @actSelAllExecute; fActSelAll.Caption := 'Select all'; fActSaveMsg := TAction.Create(self); fActSaveMsg.OnExecute := @actSaveMsgExecute; fActSaveMsg.caption := 'Save selected message(s) to...'; fActDemangle := TAction.Create(self); fActDemangle.OnExecute := @actDemangleExecute; fActDemangle.caption := 'Demangle selection'; inherited; fImages:= TImageList.Create(self); Case GetIconScaledSize of iss16: begin fImages.Width:=16; fImages.Height:=16; AssignPng(TreeFilterEdit1.Glyph, 'FILTER_CLEAR'); fImages.AddResourceName(HINSTANCE, 'BALLOON'); fImages.AddResourceName(HINSTANCE, 'INFORMATION'); fImages.AddResourceName(HINSTANCE, 'LIGHTBULB_OFF'); fImages.AddResourceName(HINSTANCE, 'WARNING'); fImages.AddResourceName(HINSTANCE, 'EXCLAMATION'); end; iss24: begin fImages.Width:=24; fImages.Height:=24; AssignPng(TreeFilterEdit1.Glyph, 'FILTER_CLEAR24'); fImages.AddResourceName(HINSTANCE, 'BALLOON24'); fImages.AddResourceName(HINSTANCE, 'INFORMATION24'); fImages.AddResourceName(HINSTANCE, 'LIGHTBULB_OFF24'); fImages.AddResourceName(HINSTANCE, 'WARNING24'); fImages.AddResourceName(HINSTANCE, 'EXCLAMATION24'); end; iss32: begin fImages.Width:=32; fImages.Height:=32; AssignPng(TreeFilterEdit1.Glyph, 'FILTER_CLEAR32'); fImages.AddResourceName(HINSTANCE, 'BALLOON32'); fImages.AddResourceName(HINSTANCE, 'INFORMATION32'); fImages.AddResourceName(HINSTANCE, 'LIGHTBULB_OFF32'); fImages.AddResourceName(HINSTANCE, 'WARNING32'); fImages.AddResourceName(HINSTANCE, 'EXCLAMATION32'); end; end; List.Images := fImages; List.DefaultItemHeight:= ScaleY(22,96); fMsgColors[amkBub] := $FCE7D2; fMsgColors[amkWarn] := $B3FFFF; fMsgColors[amkErr] := $BDBDFF; fMsgColors[amkInf] := $FFD0A8; fMsgColors[amkHint] := $C2FFC2; updaterByLoopInterval := 200; fOptions := TMessagesOptions.Create(Self); fOptions.assign(self); fOptions.Name:= 'messageOptions'; fOptionsBackup := TMessagesOptions.Create(Self); List.PopupMenu := contextMenu; List.OnDeletion := @ListDeletion; List.OnDblClick := @handleMessageClick; btnSelProj.OnClick := @selCtxtClick; btnSelMisc.OnClick := @selCtxtClick; btnSelEdit.OnClick := @selCtxtClick; btnSelApp.OnClick := @selCtxtClick; btnSelAll.OnClick := @selCtxtClick; fBtns[amcAll] := btnSelAll; fBtns[amcApp] := btnSelApp; fBtns[amcEdit]:= btnSelEdit; fBtns[amcMisc]:= btnSelMisc; fBtns[amcProj]:= btnSelProj; btnClearCat.OnClick := @actClearCurCatExecute; fEditorMessagePos := TEditorMessagePos.Create; fname := getDocPath + optname; if fname.fileExists then begin fOptions.loadFromFile(fname); fOptions.AssignTo(self); end; EntitiesConnector.addObserver(self); EntitiesConnector.addSingleService(self); end; destructor TMessagesWidget.destroy; begin fEditorMessagePos.Free; fOptions.saveToFile(getDocPath + optname); EntitiesConnector.removeObserver(self); inherited; end; procedure TMessagesWidget.setToolBarFlat(value: boolean); begin inherited setToolBarFlat(value); TreeFilterEdit1.Flat:=value; end; procedure TMessagesWidget.listDeletion(Sender: TObject; Node: TTreeNode); begin if node.data.isAssigned then Dispose(PMessageData(Node.Data)); end; procedure TMessagesWidget.ListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var i: integer; n: TTreeNode; begin case Key of VK_BACK, VK_DELETE: begin if List.SelectionCount > 0 then begin for i := List.Items.Count-1 downto 0 do begin n := List.Items[i]; if n.MultiSelected then List.Items.Delete(n); end; end else clearbyContext(amcAll); end; VK_UP, VK_DOWN: if fOptions.singleMessageClick then handleMessageClick(nil); VK_RETURN: handleMessageClick(nil); end; end; procedure TMessagesWidget.toolbarResize(Sender: TObject); begin TreeFilterEdit1.Width := toolbar.Width - TreeFilterEdit1.Left - TreeFilterEdit1.BorderSpacing.Around; end; procedure TMessagesWidget.TreeFilterEdit1AfterFilter(Sender: TObject); begin fFiltering := TreeFilterEdit1.Filter.isNotEmpty; filterMessages(fCtxt); end; procedure TMessagesWidget.TreeFilterEdit1ButtonClick(Sender: TObject); begin fFiltering := false; filterMessages(fCtxt); end; procedure TMessagesWidget.selCtxtClick(Sender: TObject); var btn: TToolButton; i: Integer; o: TAppMessageCtxt; begin if sender.isNotAssigned then exit; // o := fCtxt; fCtxt := amcAll; btn := TToolButton(Sender); for i := 0 to toolbar.ButtonCount-1 do toolbar.Buttons[i].Down := toolbar.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; if o <> fCtxt then fJustChangedContext := true; filterMessages(fCtxt); end; procedure TMessagesWidget.setMaxMessageCount(value: Integer); begin if value < 5 then value := 5; if fMaxMessCnt = value then exit; fMaxMessCnt := value; clearOutOfRangeMessg; end; procedure TMessagesWidget.setAutoSelectCategory(value: boolean); begin fAutoSelect := value; fActAutoSel.Checked:= fAutoSelect; end; procedure TMessagesWidget.setSingleMessageClick(value: boolean); begin fSingleClick := value; if fSingleClick then begin List.OnClick := @handleMessageClick; List.OnDblClick:= nil; end else begin List.OnClick := nil; List.OnDblClick:= @handleMessageClick; end; end; procedure TMessagesWidget.setColorError(value: TColor); begin fMsgColors[amkErr] := max(value, minColor); List.Invalidate; end; procedure TMessagesWidget.setColorInfo(value: TColor); begin fMsgColors[amkInf] := max(value, minColor); List.Invalidate; end; procedure TMessagesWidget.setColorHint(value: TColor); begin fMsgColors[amkHint] := max(value, minColor); List.Invalidate; end; procedure TMessagesWidget.setColorBuble(value: TColor); begin fMsgColors[amkBub] := max(value, minColor); List.Invalidate; end; procedure TMessagesWidget.setColorWarning(value: TColor); begin fMsgColors[amkWarn] := value; List.Invalidate; end; procedure TMessagesWidget.ListCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); var x: integer; rc: TRect; r: TStringRange = (ptr:nil; pos:0; len: 0); t: TStringRange; s: string; p: boolean = false; c: array [boolean] of TColor; begin rc := node.DisplayRect(false); x := rc.Left + 2 - TTreeHack(list).ScrolledLeft; // warning: the cast may become wrong if the enum is modified. Sender.Canvas.Brush.Color := fMsgColors[TAppMessageKind(node.ImageIndex + 1)]; c[false] := Sender.Canvas.font.Color; c[true] := fOptions.colorHighlight; if node.Selected then begin Sender.Canvas.DrawFocusRect(rc); Sender.Canvas.Brush.Color := Sender.Canvas.Brush.Color - minColor; end; Sender.Canvas.FillRect(rc); list.Images.Draw(sender.Canvas, x, (rc.Top + rc.Bottom - list.Images.Height) div 2, node.ImageIndex, Node.NodeEffect); x += list.Images.Width + 5; if not fOptions.backticksHighlight then Sender.Canvas.TextOut(x, rc.Top, Node.Text) else if node.Text.isNotEmpty then begin r.init(node.Text); while not r.empty do begin p := false; // non highlighted part t := r.takeUntil('`'); s := t.yield(); Sender.Canvas.font.Color:= c[p]; Sender.Canvas.TextOut(x, rc.Top, s); x += sender.Canvas.TextWidth(s); // possibly highlighted part if not r.empty() and (r.front = '`') then begin r.popFront(); s := '`'; t := r.takeUntil('`'); p := not r.empty() and (r.front() = '`'); if p then begin t := t.takeMore(1); r.popFront(); end; s += t.yield(); Sender.Canvas.font.Color:= c[p]; Sender.Canvas.TextOut(x, rc.Top, s); x += sender.Canvas.TextWidth(s); end; end; end; DefaultDraw := false; end; {$ENDREGION} {$REGION IEditableOptions ----------------------------------------------------} function TMessagesWidget.optionedWantCategory(): string; begin exit('Messages'); end; function TMessagesWidget.optionedWantEditorKind: TOptionEditorKind; begin exit(oekGeneric); end; function TMessagesWidget.optionedWantContainer: TPersistent; begin fOptions.assign(self); fOptionsBackup.assign(self); exit(fOptions); end; procedure TMessagesWidget.optionedEvent(event: TOptionEditorEvent); begin case event of oeeAccept, oeeSelectCat: fOptionsBackup.assign(fOptions); oeeCancel: fOptions.assign(fOptionsBackup); end; fOptions.AssignTo(self); List.Invalidate; end; function TMessagesWidget.optionedOptionsModified: boolean; begin exit(false); end; {$ENDREGION} {$REGION IContextualActions---------------------------------------------------} function TMessagesWidget.contextName: string; begin result := 'Messages'; end; function TMessagesWidget.contextActionCount: integer; begin result := 7; end; function TMessagesWidget.contextAction(index: integer): TAction; begin case index of 0: result := fActAutoSel; 1: result := fActClearAll; 2: result := fActClearCurCat; 3: result := fActCopyMsg; 4: result := fActSelAll; 5: result := fActSaveMsg; 6: result := fActDemangle; else result := nil; end; end; procedure TMessagesWidget.actDemangleExecute(Sender: TObject); var i: integer; begin for i:= 0 to List.SelectionCount-1 do list.Selections[i].Text := demangle(list.Selections[i].Text); end; procedure TMessagesWidget.actAutoSelExecute(Sender: TObject); begin fAutoSelect := fActAutoSel.Checked; fOptions.autoSelect:=fAutoSelect; end; procedure TMessagesWidget.actClearAllExecute(Sender: TObject); begin clearbyContext(amcAll); end; procedure TMessagesWidget.actClearCurCatExecute(Sender: TObject); begin case fCtxt of amcAll, amcApp, amcMisc : clearbyContext(fCtxt); amcEdit: if fDoc.isAssigned then clearbyData(fDoc); amcProj: if fProj.isAssigned then clearbyData(fProj); end; end; procedure TMessagesWidget.actCopyMsgExecute(Sender: TObject); var i: integer; s: string = ''; n: TTreeNode; begin for i := 0 to List.Items.Count-1 do begin n := List.Items[i]; if n.MultiSelected then s += n.Text + LineEnding; end; Clipboard.AsText := s; end; procedure TMessagesWidget.actSelAllExecute(Sender: TObject); var i: integer; n: TTreeNode; begin List.BeginUpdate; for i := 0 to List.Items.Count-1 do begin n := List.Items[i]; if n.Visible then n.MultiSelected := true; end; List.EndUpdate; end; procedure TMessagesWidget.actSaveMsgExecute(Sender: TObject); var lst: TStringList; itm: TtreeNode; begin with TSaveDialog.Create(nil) do try if execute then begin lst := TStringList.Create; try for itm in List.Items do lst.Add(itm.Text); lst.SaveToFile(filename.normalizePath); finally lst.Free; end; end; finally free; end; end; {$ENDREGION} {$REGION IProjectObserver ----------------------------------------------------} procedure TMessagesWidget.projNew(project: ICommonProject); begin fProj := project; filterMessages(fCtxt); end; procedure TMessagesWidget.projClosing(project: ICommonProject); begin if fProj <> project then exit; clearbyData(fProj); fProj := nil; filterMessages(fCtxt); end; procedure TMessagesWidget.projFocused(project: ICommonProject); begin if fProj = project then exit; fProj := project; filterMessages(fCtxt); end; procedure TMessagesWidget.projChanged(project: ICommonProject); begin end; procedure TMessagesWidget.projCompiling(project: ICommonProject); begin fProjCompile := true; end; procedure TMessagesWidget.projCompiled(project: ICommonProject; success: boolean); begin fProjCompile := false; end; {$ENDREGION} {$REGION IDocumentObserver ---------------------------------------------------} procedure TMessagesWidget.docNew(document: TDexedMemo); begin if fDoc.isAssigned and fOptions.fAutoSelect and (fCtxt = amcEdit) then begin if list.Selected.isAssigned then fEditorMessagePos[fDoc.fileName] := list.Selected.Index else fEditorMessagePos[fDoc.fileName] := -1; end; fDoc := document; filterMessages(fCtxt); end; procedure TMessagesWidget.docClosing(document: TDexedMemo); begin if document <> fDoc then exit; clearbyData(fDoc); fEditorMessagePos.Remove(fDoc.fileName); fDoc := nil; filterMessages(fCtxt); end; procedure TMessagesWidget.docFocused(document: TDexedMemo); var i: integer; begin if fDoc = document then exit; if fDoc.isAssigned and fOptions.fAutoSelect and (fCtxt = amcEdit) then begin if list.Selected.isAssigned then fEditorMessagePos[fDoc.fileName] := list.Selected.Index else fEditorMessagePos[fDoc.fileName] := -1; end; fDoc := document; filterMessages(fCtxt); if fOptions.fAutoSelect and (fCtxt = amcEdit) then begin i := fEditorMessagePos.IndexOf(fDoc.fileName); if i <> -1 then begin i := fEditorMessagePos.Data[i]; if (i <> -1) and (i < list.Items.Count) then begin list.Selected := list.Items[i]; list.Selected.MakeVisible; end; end; end; end; procedure TMessagesWidget.docChanged(document: TDexedMemo); begin fDoc := document; end; {$ENDREGION} {$REGION IMessagesDisplay ----------------------------------------------------} function TMessagesWidget.singleServiceName: string; begin exit('IMessagesDisplay'); end; procedure TMessagesWidget.beginMessageCall(); begin list.BeginUpdate; end; procedure TMessagesWidget.endMessageCall(); begin list.EndUpdate; end; procedure TMessagesWidget.message(const value: string; aData: Pointer; aCtxt: TAppMessageCtxt; aKind: TAppMessageKind); var dt: PMessageData; item: TTreeNode; msg: string; begin showWidget; if not fAlwaysFilter then TreeFilterEdit1.Filter:=''; if (fOptions.maxLineLength > 0) and (value.length > fOptions.maxLineLength) then msg := value[1..fOptions.maxLineLength] else msg := value; if fAutoDemangle then msg := demangle(msg); if aKind = amkAuto then aKind := guessMessageKind(msg); if aCtxt = amcAutoCompile then begin case fProjCompile of false: aCtxt := amcAutoEdit; true: aCtxt := amcAutoProj; end; end; if aCtxt = amcAutoEdit then begin aData := fDoc; aCtxt := amcEdit; end else if aCtxt = amcAutoProj then begin aData := fProj; aCtxt := amcProj; end; dt := new(PMessageData); dt^.data := aData; dt^.ctxt := aCtxt; if fAutoSelect and (fCtxt <> aCtxt) then fBtns[aCtxt].Click; if fastDisplay then IncLoopUpdate; checkIfMustScrollToBack(); item := List.Items.AddObject(nil, msg, dt); item.ImageIndex := iconIndex(aKind); item.SelectedIndex := item.ImageIndex; if not fastDisplay then begin clearOutOfRangeMessg; scrollToBack; TTreeHack(list).scrolledLeft := 0; List.Update; filterMessages(fCtxt); end else if fAlwaysFilter and fFiltering then begin filterMessages(fCtxt); end; end; procedure TMessagesWidget.clearByContext(aCtxt: TAppMessageCtxt); var i: integer; d: PMessageData; n: TTreeNode; begin list.BeginUpdate; TreeFilterEdit1.Filter := ''; if aCtxt = amcAll then List.Items.Clear else for i := List.Items.Count-1 downto 0 do begin n := List.Items[i]; d := PMessageData(n.Data); if d^.ctxt = aCtxt then List.Items.Delete(n); end; list.EndUpdate; end; procedure TMessagesWidget.clearByData(data: Pointer); var i: integer; d: PMessageData; n: TTreeNode; begin if data.isNotAssigned then exit; if (TObject(data) = fDoc) and (fDoc.isAssigned) then fEditorMessagePos[fDoc.fileName] := -1; list.BeginUpdate; TreeFilterEdit1.Filter := ''; for i := List.Items.Count-1 downto 0 do begin n := List.Items[i]; d := PMessageData(n.Data); if (d^.data = data) then List.Items.Delete(n); end; list.EndUpdate; end; {$ENDREGION} {$REGION Messages --------------------------------------------------------------} procedure TMessagesWidget.updateLoop; begin if fastDisplay then begin List.BeginUpdate; clearOutOfRangeMessg; scrollToBack; filterMessages(fCtxt); List.EndUpdate; end; end; function TMessagesWidget.iconIndex(aKind: TAppMessageKind): 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 TMessagesWidget.clearOutOfRangeMessg; begin list.BeginUpdate; while List.Items.Count > fMaxMessCnt do List.Items.Delete(List.Items.GetFirstNode); list.EndUpdate; end; procedure TMessagesWidget.checkIfMustScrollToBack(); var i: TTreeNode; begin if fJustChangedContext then begin fMustScrollToBack := true; fJustChangedContext := false; end else begin i := List.BottomItem; fMustScrollToBack := i.isAssigned and i.IsVisible; end; end; procedure TMessagesWidget.scrollToBack; begin if not Visible or not fMustScrollToBack then exit; if List.BottomItem.isAssigned then List.BottomItem.MakeVisible; end; procedure TMessagesWidget.handleMessageClick(Sender: TObject); var pos: TPoint; msg: string; dat: PMessageData; old: TDexedMemo; begin if List.Selected.isNotAssigned then exit; if ssCtrl in GetKeyShiftState then exit; old := fDoc; msg := List.Selected.Text; dat := PMessageData(List.Selected.Data); if not openFileFromDmdMessage(msg) then exit; if (fDoc <> old) and fOptions.singleMessageClick and assigned(dat) and (dat^.ctxt = amcEdit) then List.ClearSelection(false); // from here, since a doc has the focus, List.Selected is nil pos := getLineFromMessage(msg); if fDoc.isNotAssigned then exit; fDoc.setFocus; fDoc.CaretXY := pos; fDoc.SelectLine; end; function TMessagesWidget.itemShouldBeVisible(item: TTreeNode; aCtxt: TAppMessageCtxt): boolean; var msgDt: PMessageData; begin result := false; msgDt := PMessageData(item.Data); if (not assigned(msgDt)) then exit; if aCtxt = amcAll then result := true else case msgDt^.ctxt of amcEdit: result := (fDoc = TDexedMemo(msgDt^.data)) and (aCtxt = amcEdit); amcProj: result := (fProj = ICommonProject(msgDt^.data)) and (aCtxt = amcProj); amcApp: result := aCtxt = amcApp; amcMisc: result := aCtxt = amcMisc; end; end; procedure TMessagesWidget.filterMessages(aCtxt: TAppMessageCtxt); var itm: TTreeNode; i: integer; begin if updating then exit; List.BeginUpdate; for i := 0 to List.Items.Count-1 do begin itm := List.Items.Item[i]; if fFiltering then itm.Visible := itemShouldBeVisible(itm, aCtxt) and AnsiContainsText(itm.Text, TreeFilterEdit1.Filter) else itm.Visible:= itemShouldBeVisible(itm, aCtxt); itm.Selected := false; end; list.EndUpdate; end; class function messageSemantic.hash(const w: string): Word; var i: integer; begin Result := 0; for i := 1 to length(w) do Result += fCoefficients[Byte(w[i])]; Result := Result and $3F; end; class function messageSemantic.getType(const w: string): TAppMessageKind; var h: Word; begin result := amkBub; h := hash(w); if fFilled[h] and (fWords[h] = w) then result := fMap[h]; end; function TMessagesWidget.guessMessageKind(const aMessg: string): TAppMessageKind; var idt: string; rng: TStringRange = (ptr:nil; pos:0; len: 0); const alp = ['a'..'z', 'A'..'Z', '_']; begin result := amkBub; rng.init(aMessg); while true do begin if rng.empty then break; idt := rng.popUntil(alp)^.takeWhile(alp).yield; if idt = '' then exit; result := messageSemantic.getType(idt); if result <> amkBub then exit; end; end; function TMessagesWidget.getLineFromMessage(const aMessage: string): TPoint; var rng: TStringRange = (ptr:nil; pos:0; len: 0); lne: string; col: string = ''; gnuStyle: boolean; begin Result := Point(-1,-1); if aMessage.isEmpty then exit; rng.init(aMessage); {$IFDEF WINDOWS} if (aMessage.length > 3) and (aMessage[2..3] = ':\') then rng.popFrontN(3); {$ENDIF} rng.popUntil(['(', ':']); gnuStyle := (rng.front = ':') and (not rng.empty) and (rng.popFront^.front in ['1'..'9']); if gnuStyle then begin lne := rng.takeUntil([':', ' ']).yield; if rng.front = ':' then col := rng.popWhile(':')^.takeUntil(' ').yield; end else begin rng.popWhile(['(', ':']); lne := rng.takeUntil([',', ':', ')', ' ']).yield; if rng.front in [',', ':'] then col := rng.popWhile([',', ':'])^.takeUntil(')').yield; end; result.y := strToIntDef(lne, -1); result.x := strToIntDef(col, -1); end; function TMessagesWidget.openFileFromDmdMessage(const aMessage: string): boolean; var i: integer = 0; ident: string = ''; absName: string; nsr: string; const nonStandardRoot: array [0..3] of string = ('src', 'source', 'sources', 'import'); begin result := false; while (true) do begin inc(i); if i > aMessage.length then exit; // '(': line will be indicated after fname // -mixin: dmd, error in mixin(token string) '-mixinXX(' if isEditable(ident.extractFileExt) and ((aMessage[i] = '(') or (aMessage[i] = ':') or ((aMessage[i] = '-') and (i < aMessage.length-5) and (aMessage[i..i+5] = '-mixin'))) then begin // relative fname if project file is the base path to a rel. fname absName := ExpandFileName(ident); if absName.fileExists then begin getMultiDocHandler.openDocument(absName); exit(true); end; // absolute fname if FilenameIsAbsolute(ident) then begin getMultiDocHandler.openDocument(ident); exit(true); end; if fProj.isAssigned then begin // if fname relative to project path absName := expandFilenameEx(fProj.filename.extractFileDir + DirectorySeparator, ident); if absName.fileExists then begin getMultiDocHandler.openDocument(absName); exit(true); end; for nsr in nonStandardRoot do begin // if fname is relative to / absName := expandFilenameEx(fProj.filename.extractFileDir + DirectorySeparator + nsr + DirectorySeparator, ident); if absName.fileExists then begin getMultiDocHandler.openDocument(absName); exit(true); end; end; end; // finally try using pwd ... absName := expandFilenameEx(GetCurrentDir, ident); if absName.fileExists then begin getMultiDocHandler.openDocument(absName); exit(true); end; // ... and $HOME absName := expandFilenameEx(GetUserDir, ident); if absName.fileExists then begin getMultiDocHandler.openDocument(absName); exit(true); end; end // @ else if aMessage[i] = '@' then ident := '' else ident += aMessage[i]; end; end; {$ENDREGION} end.