paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-23 00:43:38 +02:00
Code Issues Packages Projects Releases Wiki Activity

started Quick Fix menu items

Browse Source 
git-svn-id: trunk@8780 -
This commit is contained in:
mattias 2006-02-20 11:33:38 +00:00
parent 6bfd1a6a95
commit 3d19914c30
13 changed files with 676 additions and 223 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -1101,6 +1101,7 @@ ide/makeresstrdlg.lfm svneol=native#text/plain
ide/makeresstrdlg.lrs svneol=native#text/plain
ide/makeresstrdlg.pas svneol=native#text/pascal
ide/miscoptions.pas svneol=native#text/pascal
ide/msgquickfixes.pas svneol=native#text/plain
ide/msgview.lfm svneol=native#text/plain
ide/msgview.lrs svneol=native#text/plain
ide/msgview.pp svneol=native#text/pascal
@ -1222,6 +1223,7 @@ ideintf/maskpropedit.lfm svneol=native#text/plain
ideintf/maskpropedit.lrs svneol=native#text/plain
ideintf/maskpropedit.pas svneol=native#text/plain
ideintf/menuintf.pas svneol=native#text/plain
ideintf/msgintf.pas svneol=native#text/plain
ideintf/newfield.lfm svneol=native#text/plain
ideintf/newfield.lrs svneol=native#text/pascal
ideintf/newfield.pas svneol=native#text/pascal

7
ide/checkcompileropts.pas
View File

@ -43,7 +43,7 @@ type
procedure Add(const Msg, CurDir: String; ProgressLine: boolean;
OriginalIndex: integer);
procedure AddMsg(const Msg, CurDir: String; OriginalIndex: integer);
procedure AddProgress(const Msg, CurDir: String);
procedure AddProgress(const Msg, CurDir: String; OriginalIndex: integer);
public
property Options: TCompilerOptions read FOptions write SetOptions;
property Test: TCompilerOptionsTest read FTest;
@ -226,9 +226,10 @@ begin
Add(Msg,CurDir,false,OriginalIndex);
end;
procedure TCheckCompilerOptsDlg.AddProgress(const Msg, CurDir: String);
procedure TCheckCompilerOptsDlg.AddProgress(const Msg, CurDir: String;
OriginalIndex: integer);
begin
Add(Msg,CurDir,false,-1);
Add(Msg,CurDir,false,OriginalIndex);
end;
initialization

25
ide/helpmanager.pas
View File

@ -36,7 +36,7 @@ uses
Classes, SysUtils, LCLProc, Forms, Controls, Buttons, StdCtrls, Dialogs,
CodeToolManager, CodeAtom, CodeCache, CustomCodeTool, CodeTree,
PascalParserTool, FindDeclarationTool,
PropEdits, HelpIntf, HelpHTML, HelpFPDoc, MacroIntf, IDEWindowIntf,
PropEdits, HelpIntf, HelpHTML, HelpFPDoc, MacroIntf, IDEWindowIntf, MsgIntf,
LazarusIDEStrConsts, TransferMacros, DialogProcs, IDEOptionDefs,
EnvironmentOpts, AboutFrm, MsgView, Project, PackageDefs, MainBar,
OutputFilter, HelpOptions, MainIntf, LazConf, ExtCtrls, LResources,
@ -591,31 +591,16 @@ end;
procedure THelpManager.ShowHelpForMessage(Line: integer);
function ParseMessage(MsgItem: TMessageLine): TStringList;
var
AnOutputFilter: TOutputFilter;
CurParts: TOutputLine;
function ParseMessage(MsgItem: TIDEMessageLine): TStringList;
begin
Result:=TStringList.Create;
Result.Values['Message']:=MsgItem.Msg;
AnOutputFilter:=TOutputFilter.Create;
try
AnOutputFilter.ReadLine(MsgItem.Msg,false);
AnOutputFilter.CurrentDirectory:=MsgItem.Directory;
CurParts:=AnOutputFilter.CurrentMessageParts;
if CurParts<>nil then
debugln('THelpManager.ShowHelpForMessage ',CurParts.Text)
else
debugln('THelpManager.ShowHelpForMessage no parts');
if CurParts<>nil then
Result.Assign(CurParts);
finally
AnOutputFilter.Free;
end;
if MsgItem.Parts<>nil then
Result.Assign(MsgItem.Parts);
end;
var
MsgItem: TMessageLine;
MsgItem: TIDEMessageLine;
MessageParts: TStringList;
begin
debugln('THelpManager.ShowHelpForMessage A Line=',dbgs(Line));

17
ide/main.pp
View File

@ -104,7 +104,7 @@ uses
// source editing
UnitEditor, CodeToolsOptions, IDEOptionDefs, CheckLFMDlg,
CodeToolsDefines, DiffDialog, DiskDiffsDialog, UnitInfoDlg, EditorOptions,
ViewUnit_dlg,
MsgQuickFixes, ViewUnit_dlg,
// rest of the ide
Splash, IDEDefs, LazarusIDEStrConsts, LazConf, MsgView, SearchResultView,
CodeTemplatesDlg,
@ -503,6 +503,7 @@ type
procedure SetupCodeMacros;
procedure SetupControlSelection;
procedure SetupIDECommands;
procedure SetupIDEMsgQuickFixItems;
procedure SetupStartProject;
procedure ReOpenIDEWindows;
@ -1016,6 +1017,7 @@ begin
EditorOpts:=TEditorOptions.Create;
SetupIDECommands;
SetupIDEMsgQuickFixItems;
EditorOpts.Load;
EnvironmentOptions.ExternalTools.LoadShortCuts(EditorOpts.KeyMap);
@ -1150,6 +1152,7 @@ begin
FreeThenNil(Project1);
// free IDE parts
FreeStandardIDEQuickFixItems;
FreeFormEditor;
FreeAndNil(FindReplaceDlg);
FreeAndNil(MessagesView);
@ -1629,6 +1632,11 @@ begin
EditorOpts.KeyMap.CreateDefaultMapping;
end;
procedure TMainIDE.SetupIDEMsgQuickFixItems;
begin
InitStandardIDEQuickFixItems;
end;
procedure TMainIDE.SetupStartProject;
function ExtractCmdLineFilenames: TStrings;
@ -7330,8 +7338,7 @@ begin
// change tool status
ToolStatus:=itBuilder;
TheOutputFilter.OnAddFilteredLine:=@MessagesView.AddMsg;
TheOutputFilter.OnReadLine:=@MessagesView.AddProgress;
ConnectOutputFilter;
// compile
Result:=TheCompiler.Compile(Project1, pbfCleanCompile in Flags,
@ -12107,9 +12114,7 @@ begin
end else begin
MessagesView.Clear;
DoArrangeSourceEditorAndMessageView(false);
TheOutputFilter.OnAddFilteredLine:=@MessagesView.AddMsg;
TheOutputFilter.OnReadLine:=@MessagesView.AddProgress;
ConnectOutputFilter;
end;
end;

15
ide/mainbase.pas
View File

@ -61,10 +61,10 @@ uses
CodeCache, AVL_Tree, SynEditKeyCmds,
// IDE
LazConf, LazarusIDEStrConsts, SrcEditorIntf, LazIDEIntf, MenuIntf,
IDECommands,
IDECommands, MsgIntf,
ProjectDefs, Project, PublishModule, BuildLazDialog, Compiler,
ComponentReg,
TransferMacros, ObjectInspector, PropEdits, OutputFilter, IDEDefs, MsgView,
ComponentReg, OutputFilter,
TransferMacros, ObjectInspector, PropEdits, IDEDefs, MsgView,
EnvironmentOpts, EditorOptions, CompilerOptions, KeyMapping, IDEProcs,
Debugger, IDEOptionDefs, CodeToolsDefines, Splash, Designer,
UnitEditor, MainBar, MainIntf;
@ -115,6 +115,8 @@ type
procedure mnuWindowsItemClick(Sender: TObject); virtual;
procedure OnMainBarDestroy(Sender: TObject); virtual;
procedure ConnectOutputFilter;
public
property ToolStatus: TIDEToolStatus read FToolStatus write SetToolStatus;
@ -223,6 +225,13 @@ begin
//writeln('TMainIDEBase.OnMainBarDestroy');
end;
procedure TMainIDEBase.ConnectOutputFilter;
begin
TheOutputFilter.OnAddFilteredLine:=@MessagesView.AddMsg;
TheOutputFilter.OnReadLine:=@MessagesView.AddProgress;
TheOutputFilter.OnEndReading:=@MessagesView.CollectLineParts;
end;
procedure TMainIDEBase.SetToolStatus(const AValue: TIDEToolStatus);
begin
if FToolStatus=AValue then exit;

70
ide/msgquickfixes.pas Normal file
View File

@ -0,0 +1,70 @@
{
***************************************************************************
* *
* 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 <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
Defines the standard message Quick Fix menu items.
}
unit MsgQuickFixes;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLProc, MsgIntf, LazarusIDEStrConsts;
procedure QuickFixParameterNotUsed(Sender: TObject; Msg: TIDEMessageLine);
procedure QuickFixUnitNotUsed(Sender: TObject; Msg: TIDEMessageLine);
procedure InitStandardIDEQuickFixItems;
procedure FreeStandardIDEQuickFixItems;
implementation
procedure QuickFixParameterNotUsed(Sender: TObject; Msg: TIDEMessageLine);
begin
DebugLn('QuickFixParameterNotUsed ');
end;
procedure QuickFixUnitNotUsed(Sender: TObject; Msg: TIDEMessageLine);
begin
DebugLn('QuickFixUnitNotUsed ');
end;
procedure InitStandardIDEQuickFixItems;
begin
IDEMsgQuickFixes:=TIDEMsgQuickFixItems.Create;
//RegisterIDEMsgQuickFix('Parameter xxx not used','Quick fix: Add dummy line',
// 'Parameter "[a-z_0-9]+" not used',nil,@QuickFixParameterNotUsed);
RegisterIDEMsgQuickFix('Unit xxx not used in yyy','Quick fix: Remove unit',
'Unit "[a-z_0-9]+" not used in [a-z_0-9]+',nil,@QuickFixUnitNotUsed);
end;
procedure FreeStandardIDEQuickFixItems;
begin
FreeThenNil(IDEMsgQuickFixes);
end;
end.

1
ide/msgview.lfm
View File

@ -25,6 +25,7 @@ object MessagesView: TMessagesView
Width = 722
end
object MainPopupMenu: TPopupMenu
OnPopup = MainPopupMenuPopup
left = 46
top = 41
end

4
ide/msgview.lrs
View File

@ -9,6 +9,6 @@ LazarusResources.Add('TMessagesView','FORMDATA',[
+#6'Height'#2'O'#3'Top'#3#6#2#5'Width'#3#210#2#0#8'TListBox'#11'MessageView'#5
+'Align'#7#8'alClient'#11'MultiSelect'#9#6'OnExit'#7#15'MessageViewExit'#9'Po'
+'pupMenu'#7#13'MainPopupMenu'#8'TabOrder'#2#0#8'TopIndex'#2#255#6'Height'#2
+'O'#5'Width'#3#210#2#0#0#10'TPopupMenu'#13'MainPopupMenu'#4'left'#2'.'#3'top'
+#2')'#0#0#0
+'O'#5'Width'#3#210#2#0#0#10'TPopupMenu'#13'MainPopupMenu'#7'OnPopup'#7#18'Ma'
+'inPopupMenuPopup'#4'left'#2'.'#3'top'#2')'#0#0#0
]);

215
ide/msgview.pp
View File

@ -54,36 +54,14 @@ uses
LCLProc,
LResources,
MenuIntf,
MsgIntf,
Menus,
StdCtrls,
SysUtils;
type
{ TMessageLine }
TMessageLine = class
private
FDirectory: string;
FMsg: string;
FOriginalIndex: integer;
FParts: TStrings;
FPosition: integer;
FVisiblePosition: integer;
procedure SetDirectory(const AValue: string);
procedure SetMsg(const AValue: string);
public
constructor Create;
destructor Destroy; override;
property Msg: string Read FMsg Write SetMsg;
property Directory: string Read FDirectory Write SetDirectory;
property Position: integer Read FPosition;
property VisiblePosition: integer Read FVisiblePosition;
property OriginalIndex: integer Read FOriginalIndex;
property Parts: TStrings Read FParts Write FParts;
end;
TOnFilterLine = procedure(MsgLine: TMessageLine; var Show: boolean) of object;
{ TMessagesView }
TMessagesView = class(TForm)
MessageView: TListBox;
MainPopupMenu: TPopupMenu;
@ -92,6 +70,7 @@ type
procedure CopyMenuItemClick(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure HelpMenuItemClick(Sender: TObject);
procedure MainPopupMenuPopup(Sender: TObject);
procedure MessageViewDblClicked(Sender: TObject);
procedure MessageViewClicked(Sender: TObject);
procedure MessageViewExit(Sender: TObject);
@ -100,15 +79,18 @@ type
procedure MessageViewDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
procedure SaveAllToFileMenuItemClick(Sender: TObject);
procedure OnQuickFixClick(Sender: TObject);
private
FItems: TFPList; // list of TMessageLine
FVisibleItems: TFPList; // list of TMessageLine (visible Items of FItems)
FItems: TFPList; // list of TIDEMessageLine
FVisibleItems: TFPList; // list of TIDEMessageLine (visible Items of FItems)
FLastLineIsProgress: boolean;
FOnSelectionChanged: TNotifyEvent;
FQuickFixItems: TFPList; // list of current TIDEMsgQuickFixItem
function GetDirectory: string;
function GetItems(Index: integer): TMessageLine;
function GetItems(Index: integer): TIDEMessageLine;
function GetMessage: string;
function GetVisibleItems(Index: integer): TMessageLine;
function GetMessageLine: TIDEMessageLine;
function GetVisibleItems(Index: integer): TIDEMessageLine;
procedure SetLastLineIsProgress(const AValue: boolean);
procedure DoSelectionChange;
protected
@ -123,8 +105,9 @@ type
procedure Add(const Msg, CurDir: string;
ProgressLine, VisibleLine: boolean; OriginalIndex: integer);
procedure AddMsg(const Msg, CurDir: string; OriginalIndex: integer);
procedure AddProgress(const Msg, CurDir: string);
procedure AddProgress(const Msg, CurDir: string; OriginalIndex: integer);
procedure AddSeparator;
procedure CollectLineParts(Sender: TObject; SrcLines: TIDEMessageLineList);
procedure ClearTillLastSeparator;
procedure ShowTopMessage;
procedure Clear;
@ -146,8 +129,8 @@ type
Write SetSelectedLineIndex;
property OnSelectionChanged: TNotifyEvent
Read FOnSelectionChanged Write FOnSelectionChanged;
property Items[Index: integer]: TMessageLine Read GetItems;
property VisibleItems[Index: integer]: TMessageLine Read GetVisibleItems;
property Items[Index: integer]: TIDEMessageLine Read GetItems;
property VisibleItems[Index: integer]: TIDEMessageLine Read GetVisibleItems;
end;
var
@ -157,13 +140,14 @@ var
MsgCopyAllAndHiddenIDEMenuCommand: TIDEMenuCommand;
MsgHelpIDEMenuCommand: TIDEMenuCommand;
MsgSaveAllToFileIDEMenuCommand: TIDEMenuCommand;
MsgQuickFixIDEMenuSection: TIDEMenuSection;
const
MessagesMenuRootName = 'Messages';
procedure RegisterStandardMessagesViewMenuItems;
function MessageLinesAsText(ListOfTMessageLine: TFPList): string;
function MessageLinesAsText(ListOfTIDEMessageLine: TFPList): string;
implementation
@ -192,29 +176,30 @@ begin
MsgSaveAllToFileIDEMenuCommand :=
RegisterIDEMenuCommand(Path, 'Copy selected',
lisSaveAllMessagesToFile);
MsgQuickFixIDEMenuSection := RegisterIDEMenuSection(Path, 'Quick Fix');
end;
function MessageLinesAsText(ListOfTMessageLine: TFPList): string;
function MessageLinesAsText(ListOfTIDEMessageLine: TFPList): string;
var
i: Integer;
NewLength: Integer;
Line: TMessageLine;
Line: TIDEMessageLine;
p: Integer;
e: string;
LineEndingLength: Integer;
begin
if (ListOfTMessageLine=nil) or (ListOfTMessageLine.Count=0) then exit('');
if (ListOfTIDEMessageLine=nil) or (ListOfTIDEMessageLine.Count=0) then exit('');
NewLength:=0;
e:=LineEnding;
LineEndingLength:=length(e);
for i:=0 to ListOfTMessageLine.Count-1 do begin
Line:=TMessageLine(ListOfTMessageLine[i]);
for i:=0 to ListOfTIDEMessageLine.Count-1 do begin
Line:=TIDEMessageLine(ListOfTIDEMessageLine[i]);
inc(NewLength,length(Line.Msg)+LineEndingLength);
end;
SetLength(Result,NewLength);
p:=1;
for i:=0 to ListOfTMessageLine.Count-1 do begin
Line:=TMessageLine(ListOfTMessageLine[i]);
for i:=0 to ListOfTIDEMessageLine.Count-1 do begin
Line:=TIDEMessageLine(ListOfTIDEMessageLine[i]);
if Line.Msg<>'' then begin
System.Move(Line.Msg[1],Result[p],length(Line.Msg));
inc(p,length(Line.Msg));
@ -251,6 +236,8 @@ begin
MsgSaveAllToFileIDEMenuCommand.OnClick := @SaveAllToFileMenuItemClick;
EnvironmentOptions.IDEWindowLayoutList.Apply(Self, Name);
FQuickFixItems:=TFPList.Create;
end;
destructor TMessagesView.Destroy;
@ -258,12 +245,13 @@ begin
ClearItems;
FreeThenNil(FItems);
FreeThenNil(FVisibleItems);
FreeThenNil(FQuickFixItems);
inherited Destroy;
end;
procedure TMessagesView.DeleteLine(Index: integer);
var
Line: TMessageLine;
Line: TIDEMessageLine;
VisibleIndex: integer;
i: integer;
begin
@ -280,9 +268,9 @@ begin
for i := Index to FItems.Count - 1 do
begin
Line := Items[i];
Dec(Line.FPosition);
Line.Position:=Line.Position-1;
if Line.VisiblePosition > VisibleIndex then
Dec(Line.FVisiblePosition);
Line.VisiblePosition:=Line.VisiblePosition-1;
end;
end;
@ -292,14 +280,15 @@ end;
procedure TMessagesView.Add(const Msg, CurDir: string;
ProgressLine, VisibleLine: boolean; OriginalIndex: integer);
var
NewMsg: TMessageLine;
NewMsg: TIDEMessageLine;
i: integer;
begin
NewMsg := TMessageLine.Create;
NewMsg := TIDEMessageLine.Create;
NewMsg.Msg := Msg;
NewMsg.Directory := CurDir;
NewMsg.FPosition := FItems.Count;
NewMsg.FOriginalIndex := OriginalIndex;
NewMsg.Position := FItems.Count;
NewMsg.OriginalIndex := OriginalIndex;
//DebugLn('TMessagesView.Add FItems.Count=',dbgs(FItems.Count),' OriginalIndex=',dbgs(OriginalIndex));
FItems.Add(NewMsg);
if VisibleLine then
@ -308,14 +297,14 @@ begin
begin
// replace old progress line
i := FVisibleItems.Count - 1;
VisibleItems[i].FVisiblePosition := -1;
VisibleItems[i].VisiblePosition := -1;
FVisibleItems.Delete(i);
MessageView.Items[i] := Msg;
end
else
else begin
MessageView.Items.Add(Msg)// add line
;
NewMsg.FVisiblePosition := FVisibleItems.Count;
end;
NewMsg.VisiblePosition := FVisibleItems.Count;
FVisibleItems.Add(NewMsg);
FLastLineIsProgress := ProgressLine;
MessageView.TopIndex := MessageView.Items.Count - 1;
@ -327,9 +316,10 @@ begin
Add(Msg, CurDir, False, True, OriginalIndex);
end;
procedure TMessagesView.AddProgress(const Msg, CurDir: string);
procedure TMessagesView.AddProgress(const Msg, CurDir: string;
OriginalIndex: integer);
begin
Add(Msg, CurDir, True, True, -1);
Add(Msg, CurDir, True, True, OriginalIndex);
end;
procedure TMessagesView.AddSeparator;
@ -337,6 +327,32 @@ begin
Add(SeparatorLine, '', False, True, -1);
end;
procedure TMessagesView.CollectLineParts(Sender: TObject;
SrcLines: TIDEMessageLineList);
var
i: Integer;
SrcLine: TIDEMessageLine;
DestLine: TIDEMessageLine;
begin
//DebugLn('TMessagesView.CollectLineParts ',dbgsName(Sender),' ',dbgsName(SrcLines));
if Sender=nil then ;
if SrcLines=nil then exit;
for i:=0 to SrcLines.Count-1 do begin
SrcLine:=SrcLines[i];
DestLine:=Items[i];
if (SrcLine.OriginalIndex=DestLine.OriginalIndex) then begin
if SrcLine.Parts<>nil then begin
if DestLine.Parts=nil then
DestLine.Parts:=TStringList.Create;
DestLine.Parts.Assign(SrcLine.Parts);
end else if DestLine.Parts<>nil then
DestLine.Parts.Clear;
end else begin
//DebugLn('TMessagesView.CollectLineParts WARNING: ',dbgs(SrcLine.OriginalIndex),'<>',dbgs(DestLine.OriginalIndex));
end;
end;
end;
procedure TMessagesView.ClearTillLastSeparator;
var
LastSeparator: integer;
@ -369,7 +385,7 @@ procedure TMessagesView.FilterLines(Filter: TOnFilterLine);
// recalculate visible lines
var
i: integer;
Line: TMessageLine;
Line: TIDEMessageLine;
ShowLine: boolean;
begin
// remove temporary lines
@ -384,11 +400,11 @@ begin
Filter(Line, ShowLine);
if ShowLine then
begin
Line.FVisiblePosition := FVisibleItems.Count;
Line.VisiblePosition := FVisibleItems.Count;
FVisibleItems.Add(Line);
end
else
Line.FVisiblePosition := -1;
Line.VisiblePosition := -1;
end;
// rebuild MessageView.Items
MessageView.Items.BeginUpdate;
@ -485,9 +501,19 @@ begin
Result := MessageView.Items.Strings[GetSelectedLineIndex];
end;
function TMessagesView.GetVisibleItems(Index: integer): TMessageLine;
function TMessagesView.GetMessageLine: TIDEMessageLine;
var
i: LongInt;
begin
Result := TMessageLine(FVisibleItems[Index]);
Result:=nil;
i:=GetSelectedLineIndex;
if (i>=0) and (i<FVisibleItems.Count) then
Result:=VisibleItems[i];
end;
function TMessagesView.GetVisibleItems(Index: integer): TIDEMessageLine;
begin
Result := TIDEMessageLine(FVisibleItems[Index]);
end;
procedure TMessagesView.MessageViewDblClicked(Sender: TObject);
@ -524,6 +550,34 @@ begin
ExecuteIDECommand(Self, ecContextHelp);
end;
procedure TMessagesView.MainPopupMenuPopup(Sender: TObject);
var
i: LongInt;
j: Integer;
QuickFixItem: TIDEMsgQuickFixItem;
Msg: TIDEMessageLine;
begin
MsgQuickFixIDEMenuSection.Clear;
Msg:=GetMessageLine;
FQuickFixItems.Clear;
if Msg<>nil then begin
for j:=0 to IDEMsgQuickFixes.Count-1 do begin
QuickFixItem:=IDEMsgQuickFixes[j];
DebugLn('TMessagesView.MainPopupMenuPopup "',Msg.Msg,'" ',QuickFixItem.Name);
if QuickFixItem.IsApplicable(Msg) then begin
FQuickFixItems.Add(QuickFixItem);
end;
end;
for i:=0 to FQuickFixItems.Count-1 do begin
QuickFixItem:=TIDEMsgQuickFixItem(FQuickFixItems[i]);
RegisterIDEMenuCommand(MsgQuickFixIDEMenuSection,
QuickFixItem.Name,
QuickFixItem.Caption,
@OnQuickFixClick);
end;
end;
end;
procedure TMessagesView.MessageViewClicked(Sender: TObject);
begin
if EnvironmentOptions.MsgViewDblClickJumps then
@ -598,6 +652,21 @@ begin
end;
end;
procedure TMessagesView.OnQuickFixClick(Sender: TObject);
var
i: Integer;
QuickFixItem: TIDEMsgQuickFixItem;
Msg: TIDEMessageLine;
begin
Msg:=GetMessageLine;
for i:=0 to FQuickFixItems.Count-1 do begin
QuickFixItem:=TIDEMsgQuickFixItem(FQuickFixItems[i]);
if QuickFixItem.Caption=(Sender as TIDEMenuItem).Caption then begin
QuickFixItem.Execute(Msg);
end;
end;
end;
function TMessagesView.GetDirectory: string;
var
i: integer;
@ -608,9 +677,9 @@ begin
Result := VisibleItems[i].Msg;
end;
function TMessagesView.GetItems(Index: integer): TMessageLine;
function TMessagesView.GetItems(Index: integer): TIDEMessageLine;
begin
Result := TMessageLine(FItems[Index]);
Result := TIDEMessageLine(FItems[Index]);
end;
function TMessagesView.GetSelectedLineIndex: integer;
@ -656,34 +725,6 @@ begin
MessageView.TopIndex := MessageView.ItemIndex;
end;
{ TMessageLine }
procedure TMessageLine.SetDirectory(const AValue: string);
begin
if FDirectory = AValue then
exit;
FDirectory := AValue;
end;
procedure TMessageLine.SetMsg(const AValue: string);
begin
if FMsg = AValue then
exit;
FMsg := AValue;
end;
constructor TMessageLine.Create;
begin
FPosition := -1;
FVisiblePosition := -1;
end;
destructor TMessageLine.Destroy;
begin
FParts.Free;
inherited Destroy;
end;
initialization
MessagesView := nil;
{$I msgview.lrs}

134
ide/outputfilter.pas
View File

@ -28,10 +28,11 @@ interface
uses
Classes, SysUtils, Forms, Controls, CompilerOptions, Project, Process,
IDEProcs, FileUtil, LclProc, LazConf, AsyncProcess;
IDEProcs, FileUtil, LclProc, LazConf, AsyncProcess, MsgIntf;
type
TOnOutputString = procedure(const Msg, Directory: String) of object;
TOnOutputString = procedure(const Msg, Directory: String;
OriginalIndex: integer) of object;
TOnAddFilteredLine = procedure(const Msg, Directory: String;
OriginalIndex: integer) of object;
TOnGetIncludePath = function(const Directory: string): string of object;
@ -49,52 +50,6 @@ type
TErrorType = (etNone, etHint, etNote, etWarning, etError, etFatal, etPanic);
{ TOutputLine }
TOutputLine = class(TStringList)
private
FDirectory: string;
public
property Directory: string read FDirectory write FDirectory;
end;
{ TOutputLines
A TStringList automatically freeing its Objects.
TOutputFilter puts all lines into in instance of TOutputLines and parses
each line. If it sees FPC output it adds a TStringList as Object to the line
and set various Name=Value pairs.
Name | Value
--------|-----------------------------------------------------------------
Stage Indicates what part of the build process the message
belongs to. Common values are 'FPC', 'Linker' or 'make'
Type For FPC: 'Hint', 'Note', 'Warning', 'Error', 'Fatal', 'Panic',
'Compiling', 'Assembling'
For make:
For Linker:
Line An integer for the linenumber as given by FPC in brackets.
Column An integer for the column as given by FPC in brackets.
Message The message text without other parsed items.
Example:
Message written by FPC:
unit1.pas(21,3) Warning: unit buttons not used
Results in
Stage=FPC
Type=Warning
Line=21
Column=3
Message=unit buttons not used
}
TOutputLines = class(TStringList)
public
destructor Destroy; override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
end;
{ TFilteredOutputLines
A TStringList maintaining an original index for each string.
TOutputFilter creates an instance of this class as a result of filtering
@ -114,6 +69,9 @@ type
procedure Exchange(Index1, Index2: Integer); override;
property OriginalIndices[Index: integer]: integer read GetOriginalIndices write SetOriginalIndices;
end;
TOFOnEndReading = procedure(Sender: TObject; Lines: TIDEMessageLineList)
of object;
{ TOutputFilter }
@ -125,8 +83,9 @@ type
FBufferingOutputLock: integer;
fCurrentDirectory: string;
fFilteredOutput: TFilteredOutputLines;
FOnEndReading: TOFOnEndReading;
fOnReadLine: TOnOutputString;
fOutput: TOutputLines;
fOutput: TIDEMessageLineList;
fLastErrorType: TErrorType;
fLastMessageType: TOutputMessageType;
fCompilingHistory: TStringList;
@ -135,14 +94,14 @@ type
fOnAddFilteredLine: TOnAddFilteredLine;
fOptions: TOuputFilterOptions;
FStopExecute: boolean;
FLastOutputLine: integer;
FLasTOutputLineParts: integer;
fLastOutputTime: TDateTime;
fLastSearchedShortIncFilename: string;
fLastSearchedIncFilename: string;
procedure DoAddFilteredLine(const s: string);
procedure DoAddLastLinkerMessages(SkipLastLine: boolean);
procedure DoAddLastAssemblerMessages;
function GetCurrentMessageParts: TOutputLine;
function GetCurrentMessageParts: TStrings;
function SearchIncludeFile(const ShortIncFilename: string): string;
procedure SetStopExecute(const AValue: boolean);
procedure InternalSetCurrentDirectory(const Dir: string);
@ -171,7 +130,7 @@ type
write fCurrentDirectory;
property FilteredLines: TFilteredOutputLines read fFilteredOutput;
property StopExecute: boolean read FStopExecute write SetStopExecute;
property Lines: TOutputLines read fOutput;
property Lines: TIDEMessageLineList read fOutput;
property LastErrorType: TErrorType read fLastErrorType;
property LastMessageType: TOutputMessageType read fLastMessageType;
property OnGetIncludePath: TOnGetIncludePath
@ -182,8 +141,9 @@ type
property Options: TOuputFilterOptions read fOptions write fOptions;
property CompilerOptions: TBaseCompilerOptions read FCompilerOptions
write FCompilerOptions;
property CurrentMessageParts: TOutputLine read GetCurrentMessageParts;
property CurrentMessageParts: TStrings read GetCurrentMessageParts;
property AsyncProcessTerminated: boolean read FAsyncProcessTerminated;
property OnEndReading: TOFOnEndReading read FOnEndReading write FOnEndReading;
end;
EOutputFilterError = class(Exception)
@ -203,18 +163,17 @@ implementation
function ErrorTypeNameToType(const Name:string): TErrorType;
begin
for Result:=Succ(etNone) to High(TErrorType) do
if AnsiCompareText(ErrorTypeNames[Result],Name)=0 then exit;
if CompareText(ErrorTypeNames[Result],Name)=0 then exit;
Result:=etNone;
end;
{ TOutputFilter }
constructor TOutputFilter.Create;
begin
inherited Create;
fFilteredOutput:=TFilteredOutputLines.Create;
fOutput:=TOutputLines.Create;
fOutput:=TIDEMessageLineList.Create;
fOptions:=[ofoSearchForFPCMessages,ofoSearchForMakeMessages,
ofoMakeFilenamesAbsolute];
Clear;
@ -225,7 +184,7 @@ begin
fOutput.Clear;
FAsyncDataAvailable:=false;
FAsyncProcessTerminated:=false;
FLastOutputLine:=-1;
FLasTOutputLineParts:=-1;
fFilteredOutput.Clear;
if fCompilingHistory<>nil then fCompilingHistory.Clear;
if fMakeDirHistory<>nil then fMakeDirHistory.Clear;
@ -320,6 +279,7 @@ begin
raise EOutputFilterError.Create('there was an error');
finally
EndBufferingOutput;
if Assigned(OnEndReading) then OnEndReading(Self,fOutput);
end;
end;
@ -333,7 +293,7 @@ begin
fOutput.Add(s);
WriteOutput(false);
if Assigned(OnReadLine) then
OnReadLine(s,fCurrentDirectory);
OnReadLine(s,fCurrentDirectory,fOutput.Count-1);
if DontFilterLine then begin
DoAddFilteredLine(s);
@ -857,14 +817,14 @@ var i: integer;
begin
// read back to 'Linking' message
i:=fOutput.Count-1;
while (i>=0) and (LeftStr(fOutput[i],length('Linking '))<>'Linking ') do
while (i>=0) and (LeftStr(fOutput[i].Msg,length('Linking '))<>'Linking ') do
dec(i);
inc(i);
// output skipped messages
while (i<fOutput.Count) do begin
if (fOutput[i]<>'')
if (fOutput[i].Msg<>'')
and ((i<fOutput.Count-1) or (not SkipLastLine)) then
DoAddFilteredLine(fOutput[i]);
DoAddFilteredLine(fOutput[i].Msg);
inc(i);
end;
end;
@ -876,29 +836,31 @@ var i: integer;
begin
// read back to 'Assembler messages:' message
i:=fOutput.Count-1;
while (i>=0) and (RightStr(fOutput[i],length(AsmStartMsg))<>AsmStartMsg) do
while (i>=0) and (RightStr(fOutput[i].Msg,length(AsmStartMsg))<>AsmStartMsg) do
dec(i);
if i<0 then exit;
while (i<fOutput.Count-1) do begin
if (fOutput[i]<>'') then
DoAddFilteredLine(fOutput[i]);
if (fOutput[i].Msg<>'') then
DoAddFilteredLine(fOutput[i].Msg);
inc(i);
end;
end;
function TOutputFilter.GetCurrentMessageParts: TOutputLine;
function TOutputFilter.GetCurrentMessageParts: TStrings;
var
Cnt: LongInt;
Line: TIDEMessageLine;
begin
Result:=nil;
if (fOutput=nil) then exit;
Cnt:=fOutput.Count;
if (Cnt=0) then exit;
Result:=TOutputLine(fOutput.Objects[Cnt-1]);
Result:=fOutput.Parts[Cnt-1];
if Result=nil then begin
Result:=TOutputLine.Create;
Result.Directory:=fCurrentDirectory;
fOutput.Objects[Cnt-1]:=Result;
Result:=TStringList.Create;
Line:=fOutput[Cnt-1];
Line.Directory:=fCurrentDirectory;
Line.Parts:=Result;
end;
end;
@ -1034,6 +996,7 @@ begin
// check for enter directory
if copy(s,i,length(EnterDirPattern))=EnterDirPattern then
begin
CurrentMessageParts.Values['Type']:='entering directory';
inc(i,length(EnterDirPattern));
if (fCurrentDirectory<>'') then begin
if (fMakeDirHistory=nil) then fMakeDirHistory:=TStringList.Create;
@ -1045,6 +1008,7 @@ begin
// check for leaving directory
if copy(s,i,length(LeavingDirPattern))=LeavingDirPattern then
begin
CurrentMessageParts.Values['Type']:='leaving directory';
if (fMakeDirHistory<>nil) and (fMakeDirHistory.Count>0) then begin
InternalSetCurrentDirectory(fMakeDirHistory[fMakeDirHistory.Count-1]);
fMakeDirHistory.Delete(fMakeDirHistory.Count-1);
@ -1063,7 +1027,7 @@ begin
while (MsgStartPos<=length(s)) and (s[MsgStartPos]=' ') do inc(MsgStartPos);
MakeMsg:=copy(s,MsgStartPos,length(s)-MsgStartPos+1);
DoAddFilteredLine(s);
if AnsiCompareText(copy(MakeMsg,1,5),'Error')=0 then
if CompareText(copy(MakeMsg,1,5),'Error')=0 then
if (ofoExceptionOnError in Options) then
raise EOutputFilterError.Create(s);
exit;
@ -1071,7 +1035,7 @@ begin
end
else begin
// TODO: under MacOS X and probably BSD too the make does not write
// entering and leaving directory
// entering and leaving directory without the -w option
end;
end;
@ -1087,9 +1051,9 @@ begin
if ((CurTime-fLastOutputTime)>HalfASecond)
or Flush or (FBufferingOutputLock<=0) then begin
s:='';
while FLastOutputLine<fOutput.Count-1 do begin
inc(FLastOutputLine);
s:=s+fOutput[FLastOutputLine]+LineEnding;
while FLasTOutputLineParts<fOutput.Count-1 do begin
inc(FLasTOutputLineParts);
s:=s+fOutput[FLasTOutputLineParts].Msg+LineEnding;
end;
if s<>'' then DbgOut(s);
fLastOutputTime:=CurTime;
@ -1109,28 +1073,6 @@ begin
WriteOutput(true);
end;
{ TOutputLines }
destructor TOutputLines.Destroy;
begin
Clear; // To free the associated objects
inherited Destroy;
end;
procedure TOutputLines.Clear;
var
i: Integer;
begin
for i:=0 to Count-1 do Objects[i].Free;
inherited Clear;
end;
procedure TOutputLines.Delete(Index: Integer);
begin
Objects[Index].Free;
inherited Delete(Index);
end;
{ TFilteredOutputLines }
function TFilteredOutputLines.GetOriginalIndices(Index: integer): integer;

1
ideintf/allideintf.pas
View File

@ -41,6 +41,7 @@ uses
MacroIntf,
MaskPropEdit,
MenuIntf,
MsgIntf,
NewItemIntf,
ObjectInspector,
ObjInspStrConsts,

12
ideintf/menuintf.pas
View File

@ -385,28 +385,28 @@ var
function RegisterIDEMenuRoot(const Name: string; MenuItem: TMenuItem = nil
): TIDEMenuSection;
function RegisterIDEMenuSection(Parent: TIDEMenuSection;
const Name: string): TIDEMenuSection;
function RegisterIDEMenuSection(const Path, Name: string): TIDEMenuSection;
const Name: string): TIDEMenuSection; overload;
function RegisterIDEMenuSection(const Path, Name: string): TIDEMenuSection; overload;
function RegisterIDESubMenu(Parent: TIDEMenuSection;
const Name, Caption: string;
const OnClickMethod: TNotifyEvent = nil;
const OnClickProc: TNotifyProcedure = nil
): TIDEMenuSection;
): TIDEMenuSection; overload;
function RegisterIDESubMenu(const Path, Name, Caption: string;
const OnClickMethod: TNotifyEvent = nil;
const OnClickProc: TNotifyProcedure = nil
): TIDEMenuSection;
): TIDEMenuSection; overload;
function RegisterIDEMenuCommand(Parent: TIDEMenuSection;
const Name, Caption: string;
const OnClickMethod: TNotifyEvent = nil;
const OnClickProc: TNotifyProcedure = nil;
const Command: TIDECommand = nil
): TIDEMenuCommand;
): TIDEMenuCommand; overload;
function RegisterIDEMenuCommand(const Path, Name, Caption: string;
const OnClickMethod: TNotifyEvent = nil;
const OnClickProc: TNotifyProcedure = nil;
const Command: TIDECommand = nil
): TIDEMenuCommand;
): TIDEMenuCommand; overload;
implementation

396
ideintf/msgintf.pas Normal file
View File

@ -0,0 +1,396 @@
{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program 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. *
* *
*****************************************************************************
Author: Mattias Gaertner
Abstract:
Interface to the IDE messages (below the source editor).
}
unit MsgIntf;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLProc, TextTools, IDECommands;
type
{ TIDEMessageLine
The IDE (TOutputFilter) parses each message line.
If it sees FPC output, it fills the Parts property and set various
Name=Value pairs.
Name | Value
--------|-----------------------------------------------------------------
Stage Indicates what part of the build process the message
belongs to. Common values are 'FPC', 'Linker' or 'make'
Type For FPC: 'Hint', 'Note', 'Warning', 'Error', 'Fatal', 'Panic',
'Compiling', 'Assembling'
For make: 'entering directory', 'leaving directory'
For Linker:
Line An integer for the linenumber as given by FPC in brackets.
Column An integer for the column as given by FPC in brackets.
Message The message text without other parsed items.
Example:
Message written by FPC:
unit1.pas(21,3) Warning: unit buttons not used
Creates the following lines in Parts:
Stage=FPC
Type=Warning
Line=21
Column=3
Message=unit buttons not used
You can access them via:
if ALine.Parts.Values['Stage']='FPC' then ...
}
TIDEMessageLine = class
private
FDirectory: string;
FMsg: string;
FOriginalIndex: integer;
FParts: TStrings;
FPosition: integer;
FVisiblePosition: integer;
procedure SetDirectory(const AValue: string);
procedure SetMsg(const AValue: string);
public
constructor Create;
destructor Destroy; override;
property Msg: string read FMsg write SetMsg;
property Directory: string read FDirectory write SetDirectory;
property Position: integer read FPosition write FPosition; // position in all available messages
property VisiblePosition: integer read FVisiblePosition write FVisiblePosition;// filtered position
property OriginalIndex: integer read FOriginalIndex write FOriginalIndex;// unsorted, unfiltered position
property Parts: TStrings read FParts write FParts;
end;
TOnFilterLine = procedure(MsgLine: TIDEMessageLine; var Show: boolean) of object;
{ TIDEMessageLineList }
TIDEMessageLineList = class
private
FItems: TFPList;
function GetCount: integer;
function GetItems(Index: integer): TIDEMessageLine;
function GetParts(Index: integer): TStrings;
procedure SetParts(Index: integer; const AValue: TStrings);
public
constructor Create;
destructor Destroy; override;
procedure Clear;
function Add(const Msg: string): integer;
function Add(Item: TIDEMessageLine): integer;
procedure Delete(Index: Integer);
public
property Count: integer read GetCount;
property Items[Index: integer]: TIDEMessageLine read GetItems; default;
property Parts[Index: integer]: TStrings read GetParts write SetParts;
end;
{ TIDEMsgQuickFixItem }
TIMQFExecuteMethod = procedure(Sender: TObject; Msg: TIDEMessageLine) of object;
TIMQFExecuteProc = procedure(Sender: TObject; Msg: TIDEMessageLine);
TIDEMsgQuickFixItem = class(TPersistent)
private
FCaption: string;
FName: string;
FOnExecuteMethod: TIMQFExecuteMethod;
FOnExecuteProc: TIMQFExecuteProc;
FRegExpression: string;
FRegExprModifiers: string;
function GetCaption: string;
procedure SetCaption(const AValue: string);
procedure SetName(const AValue: string);
procedure SetRegExpression(const AValue: string);
procedure SetRegExprModifiers(const AValue: string);
public
procedure Execute(const Msg: TIDEMessageLine); virtual;
function IsApplicable(Line: TIDEMessageLine): boolean; virtual;
public
property Name: string read FName write SetName;
property Caption: string read GetCaption write SetCaption;
property RegExpression: string read FRegExpression write SetRegExpression;
property RegExprModifiers: string read FRegExprModifiers write SetRegExprModifiers;
property OnExecuteMethod: TIMQFExecuteMethod read FOnExecuteMethod write FOnExecuteMethod;
property OnExecuteProc: TIMQFExecuteProc read FOnExecuteProc write FOnExecuteProc;
end;
{ TIDEMsgQuickFixItems }
TIDEMsgQuickFixItems = class(TPersistent)
private
FItems: TFPList;
function GetCount: integer;
function GetItems(Index: integer): TIDEMsgQuickFixItem;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
function Add(Item: TIDEMsgQuickFixItem): integer;
procedure Remove(Item: TIDEMsgQuickFixItem);
function IndexOfName(const Name: string): integer;
function FindByName(const Name: string): TIDEMsgQuickFixItem;
function NewName(const StartValue: string): string;
public
property Count: integer read GetCount;
property Items[Index: integer]: TIDEMsgQuickFixItem read GetItems; default;
end;
var
IDEMsgQuickFixes: TIDEMsgQuickFixItems; // initialized by the IDE
procedure RegisterIDEMsgQuickFix(Item: TIDEMsgQuickFixItem);
function RegisterIDEMsgQuickFix(const Name, Caption, RegExpr: string;
const ExecuteMethod: TIMQFExecuteMethod;
const ExecuteProc: TIMQFExecuteProc): TIDEMsgQuickFixItem; overload;
implementation
procedure RegisterIDEMsgQuickFix(Item: TIDEMsgQuickFixItem);
begin
IDEMsgQuickFixes.Add(Item);
end;
function RegisterIDEMsgQuickFix(const Name, Caption, RegExpr: string;
const ExecuteMethod: TIMQFExecuteMethod; const ExecuteProc: TIMQFExecuteProc
): TIDEMsgQuickFixItem;
begin
Result:=TIDEMsgQuickFixItem.Create;
Result.Name:=Name;
Result.Caption:=Caption;
Result.RegExpression:=RegExpr;
Result.OnExecuteMethod:=ExecuteMethod;
Result.OnExecuteProc:=ExecuteProc;
IDEMsgQuickFixes.Add(Result);
end;
{ TIDEMsgQuickFixItem }
function TIDEMsgQuickFixItem.GetCaption: string;
begin
if FCaption<>'' then
Result:=FCaption
else
Result:=FName;
end;
procedure TIDEMsgQuickFixItem.SetCaption(const AValue: string);
begin
if FCaption=AValue then exit;
FCaption:=AValue;
end;
procedure TIDEMsgQuickFixItem.SetName(const AValue: string);
begin
if FName=AValue then exit;
FName:=AValue;
end;
procedure TIDEMsgQuickFixItem.SetRegExpression(const AValue: string);
begin
if FRegExpression=AValue then exit;
FRegExpression:=AValue;
end;
procedure TIDEMsgQuickFixItem.SetRegExprModifiers(const AValue: string);
begin
if FRegExprModifiers=AValue then exit;
FRegExprModifiers:=AValue;
end;
procedure TIDEMsgQuickFixItem.Execute(const Msg: TIDEMessageLine);
begin
if Assigned(OnExecuteMethod) then
OnExecuteMethod(Self,Msg);
if Assigned(OnExecuteProc) then
OnExecuteProc(Self,Msg);
end;
function TIDEMsgQuickFixItem.IsApplicable(Line: TIDEMessageLine): boolean;
begin
Result:=false;
if RegExpression='' then exit;
Result:=REMatches(Line.Msg,RegExpression,RegExprModifiers);
end;
{ TIDEMsgQuickFixItems }
function TIDEMsgQuickFixItems.GetItems(Index: integer): TIDEMsgQuickFixItem;
begin
Result:=TIDEMsgQuickFixItem(FItems[Index]);
end;
function TIDEMsgQuickFixItems.GetCount: integer;
begin
Result:=FItems.Count;
end;
constructor TIDEMsgQuickFixItems.Create;
begin
FItems:=TFPList.Create;
end;
destructor TIDEMsgQuickFixItems.Destroy;
begin
Clear;
FreeAndNil(FItems);
inherited Destroy;
end;
procedure TIDEMsgQuickFixItems.Clear;
var
i: Integer;
begin
for i:=Count-1 downto 0 do Items[i].Free;
end;
function TIDEMsgQuickFixItems.Add(Item: TIDEMsgQuickFixItem): integer;
begin
Item.Name:=NewName(Item.Name);
Result:=FItems.Add(Item);
end;
procedure TIDEMsgQuickFixItems.Remove(Item: TIDEMsgQuickFixItem);
begin
FItems.Remove(Item);
end;
function TIDEMsgQuickFixItems.IndexOfName(const Name: string): integer;
begin
for Result:=0 to Count-1 do
if CompareText(Items[Result].Name,Name)=0 then exit;
Result:=-1;
end;
function TIDEMsgQuickFixItems.FindByName(const Name: string
): TIDEMsgQuickFixItem;
var
i: LongInt;
begin
i:=IndexOfName(Name);
if i>=0 then
Result:=Items[i]
else
Result:=nil;
end;
function TIDEMsgQuickFixItems.NewName(const StartValue: string): string;
begin
Result:=CreateFirstIdentifier(StartValue);
while IndexOfName(Result)>=0 do
Result:=CreateNextIdentifier(Result);
end;
{ TIDEMessageLine }
procedure TIDEMessageLine.SetDirectory(const AValue: string);
begin
if FDirectory = AValue then
exit;
FDirectory := AValue;
end;
procedure TIDEMessageLine.SetMsg(const AValue: string);
begin
if FMsg = AValue then
exit;
FMsg := AValue;
end;
constructor TIDEMessageLine.Create;
begin
FPosition := -1;
FVisiblePosition := -1;
end;
destructor TIDEMessageLine.Destroy;
begin
FParts.Free;
inherited Destroy;
end;
{ TIDEMessageLineList }
function TIDEMessageLineList.GetCount: integer;
begin
Result:=FItems.Count;
end;
function TIDEMessageLineList.GetItems(Index: integer): TIDEMessageLine;
begin
Result:=TIDEMessageLine(FItems[Index]);
end;
function TIDEMessageLineList.GetParts(Index: integer): TStrings;
begin
Result:=Items[Index].Parts;
end;
procedure TIDEMessageLineList.SetParts(Index: integer; const AValue: TStrings);
begin
Items[Index].Parts:=AValue;
end;
constructor TIDEMessageLineList.Create;
begin
FItems:=TFPList.Create;
end;
destructor TIDEMessageLineList.Destroy;
begin
Clear;
FreeAndNil(FItems);
inherited Destroy;
end;
procedure TIDEMessageLineList.Clear;
var
i: Integer;
begin
for i:=0 to FItems.Count-1 do TObject(FItems[i]).Free;
FItems.Clear;
end;
function TIDEMessageLineList.Add(const Msg: string): integer;
var
Item: TIDEMessageLine;
begin
Item:=TIDEMessageLine.Create;
Item.Msg:=Msg;
Result:=Add(Item);
end;
function TIDEMessageLineList.Add(Item: TIDEMessageLine): integer;
begin
Result:=FItems.Add(Item);
Item.OriginalIndex:=Result;
end;
procedure TIDEMessageLineList.Delete(Index: Integer);
begin
TObject(FItems[Index]).Free;
FItems.Delete(Index);
end;
end.