{ /*************************************************************************** MsgView.pp - compiler message view ---------------------------------- TMessagesView is responsible for displaying the fpc/make/codetools messages. Initial Revision : Mon Apr 17th 2000 ***************************************************************************/ *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * * *************************************************************************** } unit MsgView; {$mode objfpc}{$H+} interface uses Classes, SysUtils, AVL_Tree, LCLProc, LResources, ClipBrd, Controls, Dialogs, FileUtil, Forms, Menus, StdCtrls, IDEExternToolIntf, IDECommands, MenuIntf, IDEMsgIntf, DialogProcs, EnvironmentOpts, LazarusIDEStrConsts, IDEOptionDefs, IDEProcs, InputHistory, KeyMapping; type { TLazMessageLine } TLazMessageLine = class(TIDEMessageLine) private FColumn: integer; FFilename: string; FLineNumber: integer; FNode: TAVLTreeNode; public property Node: TAVLTreeNode read FNode write FNode; property Filename: string read FFilename write FFilename; property LineNumber: integer read FLineNumber write FLineNumber; property Column: integer read FColumn write FColumn; end; { TMessagesView } TMessagesView = class(TIDEMessagesWindowInterface) MessageListBox: TListBox; MainPopupMenu: TPopupMenu; procedure CopyAllMenuItemClick(Sender: TObject); procedure CopyAllAndHiddenMenuItemClick(Sender: TObject); procedure CopyMenuItemClick(Sender: TObject); procedure FormDeactivate(Sender: TObject); procedure HelpMenuItemClick(Sender: TObject); procedure ClearMenuItemClick(Sender: TObject); procedure MainPopupMenuPopup(Sender: TObject); procedure MessageViewDblClicked(Sender: TObject); procedure MessageViewClicked(Sender: TObject); procedure MessageViewExit(Sender: TObject); procedure MessagesViewKeyDown(Sender: TObject; var Key: word; Shift: TShiftState); procedure MessageViewDrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState); procedure SaveAllToFileMenuItemClick(Sender: TObject); procedure OnQuickFixClick(Sender: TObject); private FItems: TFPList; // list of TLazMessageLine FVisibleItems: TFPList; // list of TLazMessageLine (visible Items of FItems) FSrcPositions: TAVLTree;// tree of TLazMessageLine sorted for Filename and LineNumber FLastLineIsProgress: boolean; FOnSelectionChanged: TNotifyEvent; FQuickFixItems: TFPList; // list of current TIDEMsgQuickFixItem function GetDirectory: string; function GetItems(Index: integer): TLazMessageLine; function GetMessage: string; function GetMessageLine: TLazMessageLine; function GetVisibleItems(Index: integer): TLazMessageLine; procedure SetLastLineIsProgress(const AValue: boolean); procedure DoSelectionChange; protected fBlockCount: integer; FLastSelectedIndex: integer; function GetSelectedLineIndex: integer; procedure SetSelectedLineIndex(const AValue: integer); function FindNextItem(const Filename: string; FirstLine, LineCount: integer): TAVLTreeNode; procedure UpdateMsgSrcPos(Line: TLazMessageLine); function GetLines(Index: integer): TIDEMessageLine; override; public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; procedure DeleteLine(Index: integer); procedure Add(const Msg, CurDir: string; ProgressLine, VisibleLine: boolean; OriginalIndex: integer); procedure AddMsg(const Msg, CurDir: string; OriginalIndex: integer); override; procedure AddProgress(ScanLine: TIDEScanMessageLine); procedure AddSeparator; procedure CollectLineParts(Sender: TObject; SrcLines: TIDEMessageLineList); procedure ClearTillLastSeparator; procedure ShowTopMessage; procedure Clear; override; procedure GetVisibleMessageAt(Index: integer; var Msg, MsgDirectory: string); procedure BeginBlock; override; procedure EndBlock; override; procedure ClearItems; function LinesCount: integer; override; function VisibleItemCount: integer; function MsgCount: integer; procedure FilterLines(Filter: TOnFilterLine); procedure SaveMessagesToFile(const Filename: string); procedure SrcEditLinesInsertedDeleted(const Filename: string; FirstLine, LineCount: Integer); procedure UpdateMsgLineInListBox(Line: TLazMessageLine); function ExecuteMsgLinePlugin(Step: TIMQuickFixStep): boolean; procedure ConsistencyCheck; public property LastLineIsProgress: boolean read FLastLineIsProgress write SetLastLineIsProgress; property Message: string read GetMessage; property Directory: string read GetDirectory; property SelectedMessageIndex: integer read GetSelectedLineIndex // visible index write SetSelectedLineIndex; property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged; property Items[Index: integer]: TLazMessageLine read GetItems; property VisibleItems[Index: integer]: TLazMessageLine read GetVisibleItems; end; var MessagesView: TMessagesView = nil; MsgClearIDEMenuCommand: TIDEMenuCommand; MsgCopyIDEMenuCommand: TIDEMenuCommand; MsgCopyAllIDEMenuCommand: TIDEMenuCommand; MsgCopyAllAndHiddenIDEMenuCommand: TIDEMenuCommand; MsgHelpIDEMenuCommand: TIDEMenuCommand; MsgSaveAllToFileIDEMenuCommand: TIDEMenuCommand; MsgQuickFixIDEMenuSection: TIDEMenuSection; const MessagesMenuRootName = 'Messages'; procedure RegisterStandardMessagesViewMenuItems; function MessageLinesAsText(ListOfTLazMessageLine: TFPList): string; implementation uses Graphics, // used for TColor LCLType; // used for TOwnerDrawState const SeparatorLine = '---------------------------------------------'; type TMsgSrcPos = record Filename: string; LineNumber: integer; end; PMsgSrcPos = ^TMsgSrcPos; function CompareMsgSrcPositions(Data1, Data2: Pointer): integer; var Pos1: TLazMessageLine; Pos2: TLazMessageLine; begin Pos1:=TLazMessageLine(Data1); Pos2:=TLazMessageLine(Data2); Result:=CompareFilenames(Pos1.Filename,Pos2.Filename); if Result<>0 then exit; if Pos1.LineNumber>Pos2.LineNumber then Result:=1 else if Pos1.LineNumber0 then exit; if Pos1^.LineNumber>Pos2.LineNumber then Result:=1 else if Pos1^.LineNumber