{ Copyright (C) 2006 ***************************************************************************** See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** Author: Mattias Gaertner } unit IDEExternToolIntf; {$mode objfpc}{$H+} {$IFDEF EnableNewExtTools} interface uses Classes, SysUtils, typinfo, UTF8Process, AvgLvlTree, {$IFDEF EnableNewExtTools} {$ELSE} LazMethodList, contnrs, {$ENDIF} LazLogger, LazFileUtils, LazFileCache, Menus, LCLProc; const SubToolFPC = 'FPC'; SubToolFPCPriority = 100; SubToolFPCLinker = 'FPCLinker'; SubToolFPCRes = 'FPCRes'; SubToolMake = 'make'; SubToolMakePriority = 1000; // higher than FPC SubToolDefault = 'External Tool'; SubToolDefaultPriority = 0; type TETShareStringEvent = procedure(var s: string) of object; TMessageLineUrgency = ( mluNone, mluProgress, // time and statistics about the run mluDebug, // extreme verbosity, only useful for tool authors mluVerbose3, // all infos mluVerbose2, // almost all infos mluVerbose, // extra infos mluHint, // tool found something unusual mluNote, // maybe wrong or unnecessary mluWarning, // probably something is wrong mluImportant, // message has no urgency level, but should be shown mluError, // tool could not finish, some tools can still continue mluFatal, // critical error in input, tool had to abort mluPanic // bug in tool ); TMessageLineUrgencies = set of TMessageLineUrgency; const MessageLineUrgencyNames: array[TMessageLineUrgency] of string = ( '?', 'Progress', 'Debug', 'Verbose', 'Verbose', 'Verbose', 'Hint', 'Note', 'Warning', 'Misc', 'Error', 'Fatal', 'Panic' ); type TMessageLines = class; TAbstractExternalTool = class; TMessageLineFlag = ( mlfLeftToken, // position is about left token, otherwise right token mlfFixed, // reason for the messages was resolved, e.g. quick fixed mlfHiddenByIDEDirective, mlfHiddenByIDEDirectiveValid, mlfFileSearched // file was searched, FullFilename valid ); TMessageLineFlags = set of TMessageLineFlag; { TMessageLine } TMessageLine = packed class private // pointers FLines: TMessageLines; // owner FMsg: string; // fixed/improved message FFilename: string; FOriginalLine: string; FSubTool: string; FTranslatedMsg: string; // translated message fAttributes: TStrings; // native types FSubType: PtrUInt; FChangeStamp: int64; // special types FOutputIndex: integer; FColumn: integer; FIndex: integer; // 0-based, position in Lines.Items FLine: integer; FMsgID: integer; FUrgency: TMessageLineUrgency; FFlags: TMessageLineFlags; function GetAttribute(const Identifier: string): string; procedure SetAttribute(const Identifier: string; const AValue: string); procedure SetColumn(const AValue: integer); procedure SetFilename(AValue: string); procedure SetFlags(AValue: TMessageLineFlags); procedure SetLine(const AValue: integer); procedure SetMsg(AValue: string); procedure SetMsgID(AValue: integer); procedure SetSubTool(AValue: string); procedure SetSubType(AValue: PtrUInt); procedure SetTranslatedMsg(AValue: string); procedure SetUrgency(AValue: TMessageLineUrgency); procedure SortedSrcPosBind; procedure SortedSrcPosUnbind; protected procedure SetLines(AValue: TMessageLines); public constructor Create; virtual; destructor Destroy; override; procedure Assign(Source: TMessageLine); function Equals(Obj: TObject): boolean; override; procedure Clear; function GetShortFilename: string; inline; function GetRelativeFilename: string; function GetFullFilename: string; inline; procedure ShareStrings(const ShareStringEvent: TETShareStringEvent); virtual; procedure SetSourcePosition(NewFilename: string; NewLine, NewColumn: integer); procedure IncreaseChangeStamp; procedure MarkFixed; function HasSourcePosition: boolean; procedure GetAttributes(List: TStrings); public property Index: integer read FIndex; // index in Lines (Note: Lines can have more or less items than the raw output has text lines) property Urgency: TMessageLineUrgency read FUrgency write SetUrgency; property SubTool: string read FSubTool write SetSubTool; // e.g. SubToolFPC, SubToolMake, SubToolFPCLinker property SubType: PtrUInt read FSubType write SetSubType; // depends on SubTool property Msg: string read FMsg write SetMsg; // improved message without filename, line, column property MsgID: integer read FMsgID write SetMsgID; // message id (depends on parser, e.g. fpc writes them with -vq, MsgID<>0 if valid) property TranslatedMsg: string read FTranslatedMsg write SetTranslatedMsg; // translated Msg property Filename: string read FFilename write SetFilename; // full file name, relative if not found or not yet searched property Line: integer read FLine write SetLine; // valid if >0 property Column: integer read FColumn write SetColumn; // valid if >0 property Flags: TMessageLineFlags read FFlags write SetFlags; property Attribute[const Identifier: string]: string read GetAttribute write SetAttribute; default; // arbitrary attributes property ChangeStamp: int64 read FChangeStamp; property OutputIndex: integer read FOutputIndex; // index in raw Output, there can be only one message per output line property Lines: TMessageLines read FLines write SetLines; property OriginalLine: string read FOriginalLine; end; TMessageLineClass = class of TMessageLine; { TMessageLineEnumerator } TMessageLineEnumerator = class private FFilename: string; FMaxLine: integer; FMinLine: integer; protected FTree: TAvgLvlTree; FCurrent: TAvgLvlTreeNode; function GetCurrent: TMessageLine; inline; public constructor Create(Tree: TAvgLvlTree; const aFilename: string; aMinLine, aMaxLine: integer); function GetEnumerator: TMessageLineEnumerator; function MoveNext: boolean; property Current: TMessageLine read GetCurrent; property Filename: string read FFilename; property MinLine: integer read FMinLine; property MaxLine: integer read FMaxLine; end; { TMessageLines } TETMarksFixedEvent = procedure(ListOfTMessageLine: TFPList) of object; TMessageLines = class private FChangeStamp: int64; FCritSec: TRTLCriticalSection; FBaseDirectory: string; fItems: TFPList; // list of TMessageLine FMessageLineClass: TMessageLineClass; FOnMarksFixed: TETMarksFixedEvent; FOwner: TObject; FSortedForSrcPos: TAvgLvlTree; // tree of TMessageLine sorted for Filename, Line, Column, OutputIndex, Index FUpdateSortedSrcPos: boolean; fChangedHandler: TMethodList; fMarkedFixed: TAvgLvlTree; // list of TMessageLine function GetItems(Index: integer): TMessageLine; procedure SetBaseDirectory(const AValue: string); procedure LineChanged(Line: TMessageLine); public UrgencyCounts: array[TMessageLineUrgency] of integer; constructor Create(aOwner: TObject; aMsgLineClass: TMessageLineClass); destructor Destroy; override; property Owner: TObject read FOwner; procedure EnterCriticalSection; virtual; // always use before access procedure LeaveCriticalSection; virtual; function Count: integer; inline; procedure Clear; property Items[Index: integer]: TMessageLine read GetItems; default; function GetLastLine: TMessageLine; property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; // always trimmed and with trailing / function CreateLine(OutputIndex: integer): TMessageLine; // create, but do not yet add it procedure Add(MsgLine: TMessageLine); procedure Remove(MsgLine: TMessageLine); procedure Delete(MsgLine: TMessageLine); procedure MarkFixed(MsgLine: TMessageLine); // (main thread) request to add mlfFixed, will be applied in ApplyFixedMarks procedure ApplyFixedMarks; virtual; // (main thread) apply mlfFixed to all messages added via MarkFixed procedure FetchAll(SrcLines: TMessageLines); procedure SourceLinesInserted(Filename: string; Line, InsertedCount: integer); procedure SourceLinesDeleted(Filename: string; FirstLine, DeletedCount: integer); property MessageLineClass: TMessageLineClass read FMessageLineClass; property OnMarksFixed: TETMarksFixedEvent read FOnMarksFixed write FOnMarksFixed; property ChangeStamp: int64 read FChangeStamp; procedure IncreaseChangeStamp; inline; function IndexOfOutputIndex(OutputIndex: integer): integer; function EnumerateFile(aFilename: string; MinLine: integer = 0; MaxLine: integer = High(integer)): TMessageLineEnumerator; property UpdateSortedSrcPos: boolean // disable this while updating many Filename,Line,Col without changes the order read FUpdateSortedSrcPos write FUpdateSortedSrcPos; procedure AddChangedHandler(const OnLineChanged: TNotifyEvent; AsFirst: boolean = false); procedure RemoveChangedHandler(const OnLineChanged: TNotifyEvent); procedure ConsistencyCheck; end; { TExtToolParser Read the output of a tool, for example the output of the Free Pascal compiler. It does not filter. Some parsers can work together, for example make and fpc. Usage: Tool.AddParsers('fpc'); } TExtToolParser = class(TComponent) private FNeedSynchronize: boolean; FTool: TAbstractExternalTool; public destructor Destroy; override; // (main thread) procedure Init; virtual; // called after macros resolved, before starting thread (main thread) procedure InitReading; virtual; // called if process started, before first line (worker thread) procedure Done; virtual; // called after process stopped (worker thread) procedure ReadLine(Line: string; OutputIndex: integer; var Handled: boolean); virtual; abstract; // (worker thread) function CreateMsgLine(OutputIndex: integer): TMessageLine; // (worker thread) procedure AddMsgLine(MsgLine: TMessageLine); virtual; // (worker thread) property Tool: TAbstractExternalTool read FTool;// set when added to a tool property NeedSynchronize: boolean read FNeedSynchronize write FNeedSynchronize; procedure ImproveMessages({%H-}aSynchronized: boolean); virtual; // (Synchronized=true->main, else worker thread) called after parsers added lines to Tool.WorkerMessages, Tool is in Critical section procedure ConsistencyCheck; virtual; class function IsSubTool(const SubTool: string): boolean; virtual; class function GetMsgExample({%H-}SubTool: string; {%H-}MsgID: integer): string; virtual; class function GetMsgHint({%H-}SubTool: string; {%H-}MsgID: integer): string; virtual; class function GetMsgParser(Msg: TMessageLine; ParserClass: TClass): TExtToolParser; class function DefaultSubTool: string; virtual; abstract; class function Priority: integer; virtual; // higher comes first end; TExtToolParserClass = class of TExtToolParser; { TFPCParser - standard parser for Free Pascal messages, implemented by IDE } TFPCParser = class(TExtToolParser) private FHideHintsSenderNotUsed: boolean; FHideHintsUnitNotUsedInMainSource: boolean; protected FFilesToIgnoreUnitNotUsed: TStrings; public class function GetFPCParser(Msg: TMessageLine): TFPCParser; function GetFPCMsgIDPattern(MsgID: integer): string; virtual; abstract; class function MsgLineIsId(Msg: TMessageLine; MsgId: integer; out Value1, Value2: string): boolean; virtual; abstract; class function GetFPCMsgPattern(Msg: TMessageLine): string; virtual; abstract; class function GetFPCMsgValue1(Msg: TMessageLine): string; virtual; abstract; class function GetFPCMsgValues(Msg: TMessageLine; out Value1, Value2: string): boolean; virtual; abstract; property FilesToIgnoreUnitNotUsed: TStrings read FFilesToIgnoreUnitNotUsed write FFilesToIgnoreUnitNotUsed; property HideHintsSenderNotUsed: boolean read FHideHintsSenderNotUsed write FHideHintsSenderNotUsed default true; property HideHintsUnitNotUsedInMainSource: boolean read FHideHintsUnitNotUsedInMainSource write FHideHintsUnitNotUsedInMainSource default true; end; TFPCParserClass = class of TFPCParser; var IDEFPCParser: TFPCParserClass = nil; type { TMakeParser - standard parser for 'make' messages, implemented by IDE } TMakeParser = class(TExtToolParser) end; { TDefaultParser - simple parser for simple text output, no filtering } TDefaultParser = class(TExtToolParser) public procedure ReadLine(Line: string; OutputIndex: integer; var Handled: boolean ); override; class function DefaultSubTool: string; override; class function Priority: integer; override; end; const DefaultETViewMinUrgency = mluHint; type { TExtToolView } TExtToolView = class(TComponent) private FCaption: string; FExitStatus: integer; FLines: TMessageLines; FMinUrgency: TMessageLineUrgency; FOnChanged: TNotifyEvent; FPendingLines: TMessageLines; FPendingProgressLine: TMessageLine; FProgressLine: TMessageLine; FRunning: boolean; FSummaryMsg: string; FTool: TAbstractExternalTool; protected FLastWorkerMessageCount: integer; FMessageLineClass: TMessageLineClass; procedure CreateLines; virtual; procedure FetchAllPending; virtual; // (main thread) procedure ToolExited; virtual; procedure QueueAsyncOnChanged; virtual; abstract; // (worker thread) procedure RemoveAsyncOnChanged; virtual; abstract; // (main or worker thread) public constructor Create(AOwner: TComponent); override; // (main thread) destructor Destroy; override; // (main thread) procedure ProcessNewMessages({%H-}AThread: TThread); virtual; // (worker thread, Tool is in Critical section) procedure ClearLines; // (main thread) function ApplyPending: boolean; virtual; // true if something changed (main thread) procedure InputClosed; virtual; // called by Tool when source closed (main thread) function LineFits(Line: TMessageLine): boolean; virtual; // called by ProcessNewMessages (worker thread) procedure EnterCriticalSection; virtual; // Note: when using Tool and View: always lock Tool before View procedure LeaveCriticalSection; virtual; procedure ConsistencyCheck; virtual; public property Running: boolean read FRunning write FRunning; property SummaryMsg: string read FSummaryMsg write FSummaryMsg; property Tool: TAbstractExternalTool read FTool; property Caption: string read FCaption write FCaption; property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; // called in main thread property ExitStatus: integer read FExitStatus write FExitStatus; property MinUrgency: TMessageLineUrgency read FMinUrgency write FMinUrgency default DefaultETViewMinUrgency; // hide messages below this property MessageLineClass: TMessageLineClass read FMessageLineClass; function HasFinished: boolean; virtual; // not running, no pending messages public // needs critical section property PendingLines: TMessageLines read FPendingLines write FPendingLines; property PendingProgressLine: TMessageLine read FPendingProgressLine write FPendingProgressLine; property LastWorkerMessageCount: integer read FLastWorkerMessageCount; public // only main thread property Lines: TMessageLines read FLines; property ProgressLine: TMessageLine read FProgressLine; // valid if ProgressLine.Msg<>'' end; TExtToolViewClass = class of TExtToolView; TExternalToolStage = ( etsInit, etsWaitingForStart, // waiting for a process slot etsStarting, // creating the process etsRunning, etsWaitingForStop, etsStopped, etsDestroying ); TExternalToolStages = set of TExternalToolStage; TExternalToolNewOutputEvent = procedure(Sender: TObject; FirstNewMsgLine: integer) of object; TExternalToolHandler = ( ethNewOutput, ethStopped, ethAllViewsUpdated ); TIDEExternalTools = class; TExternalToolGroup = class; { TAbstractExternalTool access needs Tool.Enter/LeaveCriticalSection } TAbstractExternalTool = class(TComponent) private FData: TObject; FEnvironmentOverrides: TStrings; FEstimatedLoad: int64; FExitStatus: integer; FFreeData: boolean; FGroup: TExternalToolGroup; FHint: string; FResolveMacrosOnExecute: boolean; FThread: TThread; FWorkerDirectory: string; FWorkerMessages: TMessageLines; FParsers: TFPList; // list of TExtToolParser FTitle: string; FTools: TIDEExternalTools; FViews: TFPList; // list of TExtToolView function GetCmdLineParams: string; function GetParserCount: integer; function GetParsers(Index: integer): TExtToolParser; function GetViews(Index: integer): TExtToolView; procedure SetCmdLineParams(aParams: string); procedure SetEnvironmentOverrides(AValue: TStrings); procedure SetGroup(AValue: TExternalToolGroup); procedure SetTitle(const AValue: string); procedure AddHandler(HandlerType: TExternalToolHandler; const AMethod: TMethod; AsFirst: boolean = true); procedure RemoveHandler(HandlerType: TExternalToolHandler; const AMethod: TMethod); protected FErrorMessage: string; FExitCode: integer; FTerminated: boolean; FHandlers: array[TExternalToolHandler] of TMethodList; FStage: TExternalToolStage; FWorkerOutput: TStrings; FProcess: TProcessUTF8; FWorkerMessagesClass: TMessageLineClass; procedure DoCallNotifyHandler(HandlerType: TExternalToolHandler); function GetExecuteAfter(Index: integer): TAbstractExternalTool; virtual; abstract; function GetExecuteBefore(Index: integer): TAbstractExternalTool; virtual; abstract; procedure DoExecute; virtual; abstract; // starts thread, returns immediately procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure EnterCriticalSection; virtual; // always use before access, when using Tool and View: always lock Tool before View procedure LeaveCriticalSection; virtual; property Thread: TThread read FThread write FThread; procedure ConsistencyCheck; virtual; property Title: string read FTitle write SetTitle; property Hint: string read FHint write FHint; // this hint is shown in About dialog property Data: TObject read FData write FData; // free for user, e.g. the IDE uses TIDEExternalToolData property FreeData: boolean read FFreeData write FFreeData default false; // true = auto free Data on destroy property Tools: TIDEExternalTools read FTools; property Group: TExternalToolGroup read FGroup write SetGroup; property EstimatedLoad: int64 read FEstimatedLoad write FEstimatedLoad default 1; // used for deciding which tool to run next // handlers procedure RemoveAllHandlersOfObject(AnObject: TObject); procedure AddHandlerOnNewOutput(const OnNewOutput: TExternalToolNewOutputEvent; AsFirst: boolean = true); // called in main thread procedure RemoveHandlerOnNewOutput(const OnNewOutput: TExternalToolNewOutputEvent); procedure AddHandlerOnStopped(const OnStopped: TNotifyEvent; AsFirst: boolean = true); // called in main thread procedure RemoveHandlerOnStopped(const OnStopped: TNotifyEvent); procedure AddHandlerOnAllViewsUpdated(const OnViewsUpdated: TNotifyEvent; AsFirst: boolean = true); // called in main thread procedure RemoveHandlerOnAllViewsUpdated(const OnViewsUpdated: TNotifyEvent); // process property Process: TProcessUTF8 read FProcess; property EnvironmentOverrides: TStrings read FEnvironmentOverrides write SetEnvironmentOverrides; // if not empty, then this and IDE's environemnt will be merged and replace Process.Environment property CmdLineParams: string read GetCmdLineParams write SetCmdLineParams; function ResolveMacros: boolean; virtual; abstract; // resolve macros in Process.Executable, Process.CurrentDirectory, Process.Params, Process.Environment on Execute property ResolveMacrosOnExecute: boolean read FResolveMacrosOnExecute write FResolveMacrosOnExecute; property Stage: TExternalToolStage read FStage; procedure Execute; virtual; abstract; procedure Terminate; virtual; abstract; procedure WaitForExit; virtual; abstract; property Terminated: boolean read FTerminated; property ExitStatus: integer read FExitStatus write FExitStatus; property ErrorMessage: string read FErrorMessage write FErrorMessage; // error executing tool // output property WorkerOutput: TStrings read FWorkerOutput; // the raw output property WorkerDirectory: string read FWorkerDirectory write FWorkerDirectory; // changed by parsers, initialized from Process.CurrentDirectory property WorkerMessages: TMessageLines read FWorkerMessages; // created by parsers property WorkerMessagesClass: TMessageLineClass read FWorkerMessagesClass; // parsers property ParserCount: integer read GetParserCount; property Parsers[Index: integer]: TExtToolParser read GetParsers; // sorted for Priority function AddParsers(const SubTool: string): TExtToolParser; // will be freed on Destroy function AddParser(ParserClass: TExtToolParserClass): TExtToolParser; // will be freed on Destroy procedure DeleteParser(Parser: TExtToolParser); // disconnect and free procedure RemoveParser(Parser: TExtToolParser); // disconnect without free function IndexOfParser(Parser: TExtToolParser): integer; procedure ClearParsers(Delete: boolean = true); function FindParser(aParserClass: TExtToolParserClass): TExtToolParser; // viewers function ViewCount: integer; property Views[Index: integer]: TExtToolView read GetViews; function AddView(View: TExtToolView): integer; // (main thread) will *not* be freed on destroy procedure DeleteView(View: TExtToolView); // (main thread) disconnect and free procedure RemoveView(View: TExtToolView); // (main thread) disconnect without free function IndexOfView(View: TExtToolView): integer; procedure ClearViews(Delete: boolean = false); // (main thread) function FindUnfinishedView: TExtToolView; // dependencies procedure AddExecuteBefore(Tool: TAbstractExternalTool); virtual; abstract; function IsExecutedBefore(Tool: TAbstractExternalTool): Boolean; virtual; abstract;// search recursively procedure RemoveExecuteBefore(Tool: TAbstractExternalTool); virtual; abstract; function ExecuteBeforeCount: integer; virtual; abstract; property ExecuteBefore[Index: integer]: TAbstractExternalTool read GetExecuteBefore; function ExecuteAfterCount: integer; virtual; abstract; property ExecuteAfter[Index: integer]: TAbstractExternalTool read GetExecuteAfter; end; { TExternalToolGroup } TExternalToolGroup = class(TComponent) private FAbortIfOneFails: boolean; FItems: TFPList; // list of TAbstractExternalTool function GetItems(Index: integer): TAbstractExternalTool; procedure InternalRemove(Tool: TAbstractExternalTool); virtual; procedure InternallAdd(Tool: TAbstractExternalTool); virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Clear; virtual; function Count: integer; property Items[Index: integer]: TAbstractExternalTool read GetItems; default; property AbortIfOneFails: boolean read FAbortIfOneFails write FAbortIfOneFails; procedure ToolExited(Tool: TAbstractExternalTool); virtual; end; { TIDEExternalTools } TIDEExternalTools = class(TComponent) private function GetItems(Index: integer): TAbstractExternalTool; inline; protected fItems: TFPList; // list of TAbstractExternalTool function GetParsers(Index: integer): TExtToolParserClass; virtual; abstract; // (main thread) public constructor Create(aOwner: TComponent); override; destructor Destroy; override; function Count: integer; inline; procedure TerminateAll; virtual; abstract; procedure Clear; virtual; abstract; // terminate + free all tools property Items[Index: integer]: TAbstractExternalTool read GetItems; default; function Add(Title: string): TAbstractExternalTool; virtual; abstract; procedure ConsistencyCheck; virtual; procedure EnterCriticalSection; virtual; abstract; procedure LeaveCriticalSection; virtual; abstract; // parsers procedure RegisterParser(Parser: TExtToolParserClass); virtual; abstract; // (main thread) procedure UnregisterParser(Parser: TExtToolParserClass); virtual; abstract; // (main thread) function FindParser(const SubTool: string): TExtToolParserClass; virtual; abstract; // (main thread) function ParserCount: integer; virtual; abstract; // (main thread) property Parsers[Index: integer]: TExtToolParserClass read GetParsers; // (main thread) function GetMsgExample(SubTool: string; MsgID: integer): string; virtual; // (main thread) function GetMsgHint(SubTool: string; MsgID: integer): string; virtual; // (main thread) function GetMsgTool(Msg: TMessageLine): TAbstractExternalTool; virtual; abstract; end; var ExternalToolList: TIDEExternalTools = nil; // will be set by the IDE const IDEToolCompilePackage = 'Package'; IDEToolCompileProject = 'Project'; type { TIDEExternalToolData When the IDE compiles a package or a project it creates an instance and sets TAbstractExternalTool.Data. } TIDEExternalToolData = class public Kind: string; // e.g. IDEToolCompilePackage or IDEToolCompileProject ModuleName: string; // e.g. the package name Filename: string; // e.g. the lpi or lpk filename constructor Create(aKind, aModuleName, aFilename: string); end; type { TIDEExternalToolOptions } TETMacroFunction = function(var aValue: string): boolean of object; TIDEExternalToolOptions = class private fCmdLineParams: string; FCustomMacroFunction: TETMacroFunction; FEnvironmentOverrides: TStringList; FExecutable: string; FHint: string; FQuiet: boolean; FResolveMacros: boolean; FScanners: TStrings; fTitle: string; fWorkingDirectory: string; procedure SetEnvironmentOverrides(AValue: TStringList); procedure SetScanners(AValue: TStrings); public constructor Create; destructor Destroy; override; procedure Assign(Source: TIDEExternalToolOptions); function Equals(Obj: TObject): boolean; override; procedure Clear; property Title: string read fTitle write fTitle; property Hint: string read FHint write FHint; property Executable: string read FExecutable write FExecutable; property Filename: string read FExecutable write FExecutable; deprecated; property CmdLineParams: string read fCmdLineParams write fCmdLineParams; property WorkingDirectory: string read fWorkingDirectory write fWorkingDirectory; property EnvironmentOverrides: TStringList read FEnvironmentOverrides write SetEnvironmentOverrides; property Scanners: TStrings read FScanners write SetScanners; property ResolveMacros: boolean read FResolveMacros write FResolveMacros default true; property CustomMacroFunction: TETMacroFunction read FCustomMacroFunction write FCustomMacroFunction; property Quiet: boolean read FQuiet write FQuiet; // no user dialogs about errors end; type TRunExternalTool = function(Tool: TIDEExternalToolOptions): boolean of object; var RunExternalTool: TRunExternalTool = nil;// set by the IDE function CompareMsgLinesSrcPos(MsgLine1, MsgLine2: Pointer): integer; function dbgs(u: TMessageLineUrgency): string; overload; function dbgs(f: TMessageLineFlag): string; overload; function dbgs(Flags: TMessageLineFlags): string; overload; function dbgs(s: TExternalToolStage): string; overload; implementation function CompareMsgLinesSrcPos(MsgLine1, MsgLine2: Pointer): integer; var Line1: TMessageLine absolute MsgLine1; Line2: TMessageLine absolute MsgLine2; begin Result:=CompareFilenames(Line1.Filename,Line2.Filename); if Result<>0 then exit; if Line1.LineLine2.Line then exit(1); if Line1.ColumnLine2.Column then exit(1); if Line1.OutputIndexLine2.OutputIndex then exit(1); if Line1.IndexLine2.Index then exit(1); Result:=0; end; function dbgs(u: TMessageLineUrgency): string; begin Result:=''; WriteStr(Result,u); end; function dbgs(f: TMessageLineFlag): string; begin Result:=''; WriteStr(Result,f); end; function dbgs(Flags: TMessageLineFlags): string; var f: TMessageLineFlag; begin Result:=''; for f in Flags do begin if Result<>'' then Result+=','; Result+=dbgs(f); end; Result:='['+Result+']'; end; function dbgs(s: TExternalToolStage): string; begin Result:=''; WriteStr(Result,s); end; { TIDEExternalToolData } constructor TIDEExternalToolData.Create(aKind, aModuleName, aFilename: string); begin Kind:=aKind; ModuleName:=aModuleName; Filename:=aFilename; end; { TFPCParser } class function TFPCParser.GetFPCParser(Msg: TMessageLine): TFPCParser; begin Result:=TFPCParser(GetMsgParser(Msg,TFPCParser)); end; { TIDEExternalToolOptions } procedure TIDEExternalToolOptions.SetEnvironmentOverrides(AValue: TStringList); begin if FEnvironmentOverrides.Equals(AValue) then Exit; FEnvironmentOverrides.Assign(AValue); end; procedure TIDEExternalToolOptions.SetScanners(AValue: TStrings); begin if FScanners.Equals(AValue) then Exit; FScanners.Assign(AValue); end; constructor TIDEExternalToolOptions.Create; begin ResolveMacros:=true; FEnvironmentOverrides:=TStringList.Create; FScanners:=TStringList.Create; end; destructor TIDEExternalToolOptions.Destroy; begin FreeAndNil(FEnvironmentOverrides); FreeAndNil(FScanners); inherited Destroy; end; procedure TIDEExternalToolOptions.Assign(Source: TIDEExternalToolOptions); begin Title:=Source.Title; Executable:=Source.Executable; CmdLineParams:=Source.CmdLineParams; WorkingDirectory:=Source.WorkingDirectory; EnvironmentOverrides:=Source.EnvironmentOverrides; Scanners:=Source.Scanners; ResolveMacros:=Source.ResolveMacros; CustomMacroFunction:=Source.CustomMacroFunction; Quiet:=Source.Quiet; end; function TIDEExternalToolOptions.Equals(Obj: TObject): boolean; var Source: TIDEExternalToolOptions; begin if Obj=Self then exit(true); if Obj is TIDEExternalToolOptions then begin Source:=TIDEExternalToolOptions(Obj); Result:=(Title=Source.Title) and (Executable=Source.Executable) and (CmdLineParams=Source.CmdLineParams) and (WorkingDirectory=Source.WorkingDirectory) and EnvironmentOverrides.Equals(Source.EnvironmentOverrides) and Scanners.Equals(Source.Scanners) and (ResolveMacros=Source.ResolveMacros) and CompareMethods(TMethod(CustomMacroFunction),TMethod(Source.CustomMacroFunction)) and (Quiet=Source.Quiet); end else Result:=inherited Equals(Obj); end; procedure TIDEExternalToolOptions.Clear; begin fCmdLineParams:=''; FCustomMacroFunction:=nil; FEnvironmentOverrides.Clear; FExecutable:=''; FResolveMacros:=true; FScanners.Clear; fTitle:=''; fWorkingDirectory:=''; FQuiet:=false; end; { TExternalToolGroup } function TExternalToolGroup.GetItems(Index: integer): TAbstractExternalTool; begin Result:=TAbstractExternalTool(FItems[Index]); end; constructor TExternalToolGroup.Create(AOwner: TComponent); begin inherited Create(AOwner); FItems:=TFPList.Create; FAbortIfOneFails:=true; end; destructor TExternalToolGroup.Destroy; begin Clear; FreeAndNil(FItems); inherited Destroy; end; procedure TExternalToolGroup.Clear; var i: Integer; begin for i:=Count-1 downto 0 do Items[i].Group:=nil; end; function TExternalToolGroup.Count: integer; begin Result:=FItems.Count; end; procedure TExternalToolGroup.InternalRemove(Tool: TAbstractExternalTool); begin FItems.Remove(Tool); if FItems.Count>0 then exit; if csDestroying in ComponentState then exit; Free; end; procedure TExternalToolGroup.InternallAdd(Tool: TAbstractExternalTool); begin if FItems.IndexOf(Tool)>=0 then raise Exception.Create('already in group'); FItems.Add(Tool); end; procedure TExternalToolGroup.ToolExited(Tool: TAbstractExternalTool); var i: Integer; begin //debugln(['TExternalToolGroup.ToolExited START ',Tool.Title,' Error=',Tool.ErrorMessage,' AbortIfOneFails=',AbortIfOneFails]); if (Tool.ErrorMessage<>'') and AbortIfOneFails then begin for i:=Count-1 downto 0 do Items[i].Terminate; end; end; { TDefaultParser } procedure TDefaultParser.ReadLine(Line: string; OutputIndex: integer; var Handled: boolean); var MsgLine: TMessageLine; begin Handled:=true; //debugln(['TDefaultParser.ReadLine ',Line]); MsgLine:=CreateMsgLine(OutputIndex); MsgLine.Msg:=Line; MsgLine.Urgency:=mluImportant; AddMsgLine(MsgLine); end; class function TDefaultParser.DefaultSubTool: string; begin Result:=SubToolDefault; end; class function TDefaultParser.Priority: integer; begin Result:=SubToolDefaultPriority; end; { TMessageLineEnumerator } function TMessageLineEnumerator.GetCurrent: TMessageLine; begin Result:=TMessageLine(FCurrent.Data); end; constructor TMessageLineEnumerator.Create(Tree: TAvgLvlTree; const aFilename: string; aMinLine, aMaxLine: integer); begin FTree:=Tree; FFilename:=aFilename; fMinLine:=aMinLine; FMaxLine:=aMaxLine; end; function TMessageLineEnumerator.GetEnumerator: TMessageLineEnumerator; begin Result:=Self; end; function TMessageLineEnumerator.MoveNext: boolean; var Line: TMessageLine; CmpLine: TMessageLine; begin Result:=false; if FCurrent=nil then begin CmpLine:=TMessageLine.Create; try CmpLine.Filename:=FFilename; CmpLine.Line:=MinLine; CmpLine.Column:=Low(Integer); FCurrent:=FTree.FindNearest(CmpLine); if FCurrent=nil then exit; if FTree.Compare(FCurrent.Data,CmpLine)<0 then FCurrent:=FCurrent.Successor; finally CmpLine.Free; end; end else begin FCurrent:=FCurrent.Successor; end; if FCurrent=nil then exit; Line:=Current; if CompareFilenames(Line.Filename,FFilename)<>0 then exit; if Line.Line>MaxLine then exit; Result:=true; end; { TAbstractExternalTool } function TAbstractExternalTool.GetParserCount: integer; begin Result:=FParsers.Count; end; function TAbstractExternalTool.GetCmdLineParams: string; begin Result:=MergeCmdLineParams(Process.Parameters); end; function TAbstractExternalTool.GetParsers(Index: integer): TExtToolParser; begin Result:=TExtToolParser(FParsers[Index]); end; function TAbstractExternalTool.GetViews(Index: integer): TExtToolView; begin Result:=TExtToolView(FViews[Index]); end; procedure TAbstractExternalTool.SetCmdLineParams(aParams: string); var sl: TStringList; begin sl:=TStringList.Create; try SplitCmdLineParams(aParams,sl); Process.Parameters:=sl; finally sl.Free; end; end; procedure TAbstractExternalTool.SetEnvironmentOverrides(AValue: TStrings); begin if (FEnvironmentOverrides=AValue) or (FEnvironmentOverrides.Equals(AValue)) then Exit; FEnvironmentOverrides.Assign(AValue); end; procedure TAbstractExternalTool.SetGroup(AValue: TExternalToolGroup); begin if FGroup=AValue then Exit; if Group<>nil then Group.InternalRemove(Self); FGroup:=AValue; if Group<>nil then Group.InternallAdd(Self); end; procedure TAbstractExternalTool.SetTitle(const AValue: string); begin if FTitle=AValue then exit; FTitle:=AValue; end; procedure TAbstractExternalTool.AddHandler(HandlerType: TExternalToolHandler; const AMethod: TMethod; AsFirst: boolean); begin if FHandlers[HandlerType]=nil then FHandlers[HandlerType]:=TMethodList.Create; FHandlers[HandlerType].Add(AMethod,not AsFirst); end; procedure TAbstractExternalTool.RemoveHandler( HandlerType: TExternalToolHandler; const AMethod: TMethod); begin FHandlers[HandlerType].Remove(AMethod); end; procedure TAbstractExternalTool.DoCallNotifyHandler( HandlerType: TExternalToolHandler); begin FHandlers[HandlerType].CallNotifyEvents(Self); end; procedure TAbstractExternalTool.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if Operation=opRemove then begin EnterCriticalSection; try if FViews<>nil then FViews.Remove(AComponent); finally LeaveCriticalSection; end; end; end; constructor TAbstractExternalTool.Create(AOwner: TComponent); begin if AOwner is TIDEExternalTools then FTools:=TIDEExternalTools(AOwner); inherited Create(AOwner); if FWorkerMessagesClass=nil then FWorkerMessagesClass:=TMessageLine; FWorkerMessages:=TMessageLines.Create(Self,FWorkerMessagesClass); FParsers:=TFPList.Create; FViews:=TFPList.Create; FStage:=etsInit; FEstimatedLoad:=1; FEnvironmentOverrides:=TStringList.Create; end; destructor TAbstractExternalTool.Destroy; var h: TExternalToolHandler; begin EnterCriticalSection; try if FreeData then FreeAndNil(FData); ClearParsers; ClearViews; Group:=nil; for h:=low(FHandlers) to high(FHandlers) do FreeAndNil(FHandlers[h]); FWorkerMessages.Clear; FreeAndNil(FParsers); FreeAndNil(FViews); FreeAndNil(FEnvironmentOverrides); inherited Destroy; finally LeaveCriticalsection; end; FreeAndNil(FWorkerMessages); end; procedure TAbstractExternalTool.EnterCriticalSection; begin FWorkerMessages.EnterCriticalSection; end; procedure TAbstractExternalTool.LeaveCriticalSection; begin FWorkerMessages.LeaveCriticalSection; end; procedure TAbstractExternalTool.ConsistencyCheck; var i: Integer; begin EnterCriticalSection; try for i:=0 to ParserCount-1 do Parsers[i].ConsistencyCheck; finally LeaveCriticalSection; end; end; procedure TAbstractExternalTool.RemoveAllHandlersOfObject(AnObject: TObject); var HandlerType: TExternalToolHandler; begin for HandlerType:=Low(HandlerType) to High(HandlerType) do FHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject); end; procedure TAbstractExternalTool.AddHandlerOnStopped( const OnStopped: TNotifyEvent; AsFirst: boolean); begin AddHandler(ethStopped,TMethod(OnStopped),AsFirst); end; procedure TAbstractExternalTool.RemoveHandlerOnStopped( const OnStopped: TNotifyEvent); begin RemoveHandler(ethStopped,TMethod(OnStopped)); end; procedure TAbstractExternalTool.AddHandlerOnAllViewsUpdated( const OnViewsUpdated: TNotifyEvent; AsFirst: boolean); begin AddHandler(ethAllViewsUpdated,TMethod(OnViewsUpdated),AsFirst); end; procedure TAbstractExternalTool.RemoveHandlerOnAllViewsUpdated( const OnViewsUpdated: TNotifyEvent); begin RemoveHandler(ethAllViewsUpdated,TMethod(OnViewsUpdated)); end; procedure TAbstractExternalTool.AddHandlerOnNewOutput( const OnNewOutput: TExternalToolNewOutputEvent; AsFirst: boolean); begin AddHandler(ethNewOutput,TMethod(OnNewOutput),AsFirst); end; procedure TAbstractExternalTool.RemoveHandlerOnNewOutput( const OnNewOutput: TExternalToolNewOutputEvent); begin RemoveHandler(ethNewOutput,TMethod(OnNewOutput)); end; function TAbstractExternalTool.AddParsers(const SubTool: string ): TExtToolParser; var ParserClass: TExtToolParserClass; i: Integer; begin Result:=nil; for i:=0 to ExternalToolList.ParserCount-1 do begin ParserClass:=ExternalToolList.Parsers[i]; if not ParserClass.IsSubTool(SubTool) then continue; Result:=AddParser(ParserClass); exit; end; raise Exception.Create('unable to find parser for tool "'+SubTool+'"'); end; function TAbstractExternalTool.AddParser(ParserClass: TExtToolParserClass ): TExtToolParser; var i: Integer; begin for i:=0 to ParserCount-1 do begin Result:=Parsers[i]; if Result.ClassType=ParserClass then exit; end; Result:=ParserClass.Create(nil); i:=0; while (i=ParserClass.Priority) do inc(i); FParsers.Insert(i,Result); Result.FTool:=Self; end; procedure TAbstractExternalTool.RemoveParser(Parser: TExtToolParser); begin FParsers.Remove(Parser); if Parser.Tool<>Self then exit; Parser.FTool:=nil; end; function TAbstractExternalTool.IndexOfParser(Parser: TExtToolParser): integer; begin Result:=FParsers.IndexOf(Parser); end; procedure TAbstractExternalTool.DeleteParser(Parser: TExtToolParser); begin Parser.Free; end; procedure TAbstractExternalTool.ClearParsers(Delete: boolean); begin while ParserCount>0 do if Delete then DeleteParser(Parsers[ParserCount-1]) else RemoveParser(Parsers[ParserCount-1]); end; function TAbstractExternalTool.FindParser(aParserClass: TExtToolParserClass ): TExtToolParser; var i: Integer; begin for i:=0 to ParserCount-1 do begin Result:=Parsers[i]; if Result.InheritsFrom(aParserClass) then exit; end; Result:=nil; end; function TAbstractExternalTool.ViewCount: integer; begin Result:=FViews.Count; end; function TAbstractExternalTool.AddView(View: TExtToolView): integer; begin View.EnterCriticalSection; try if View.Tool<>nil then raise Exception.Create(''); Result:=FViews.Add(View); FreeNotification(View); View.FTool:=Self; View.Lines.BaseDirectory:=WorkerDirectory; finally View.LeaveCriticalSection; end; end; procedure TAbstractExternalTool.RemoveView(View: TExtToolView); begin View.EnterCriticalSection; try View.fTool:=nil; FViews.Remove(View); finally View.LeaveCriticalSection; end; end; function TAbstractExternalTool.IndexOfView(View: TExtToolView): integer; begin Result:=FViews.IndexOf(View); end; procedure TAbstractExternalTool.DeleteView(View: TExtToolView); begin EnterCriticalSection; try RemoveView(View); View.Free; finally LeaveCriticalSection; end; end; procedure TAbstractExternalTool.ClearViews(Delete: boolean); begin EnterCriticalSection; try while ViewCount>0 do if Delete then DeleteView(Views[ViewCount-1]) else RemoveView(Views[ViewCount-1]); finally LeaveCriticalSection; end; end; function TAbstractExternalTool.FindUnfinishedView: TExtToolView; var i: Integer; begin for i:=0 to ViewCount-1 do begin Result:=Views[i]; if not Result.HasFinished then exit; end; Result:=nil; end; { TExtToolParser } destructor TExtToolParser.Destroy; begin if Tool<>nil then Tool.RemoveParser(Self); inherited Destroy; end; procedure TExtToolParser.Init; begin end; procedure TExtToolParser.InitReading; begin end; procedure TExtToolParser.Done; begin end; function TExtToolParser.CreateMsgLine(OutputIndex: integer): TMessageLine; begin Result:=Tool.WorkerMessages.CreateLine(OutputIndex); if OutputIndex>=0 then Result.Msg:=Tool.WorkerOutput[OutputIndex]; // use raw output as default msg end; procedure TExtToolParser.AddMsgLine(MsgLine: TMessageLine); begin Tool.WorkerMessages.Add(MsgLine); end; procedure TExtToolParser.ImproveMessages(aSynchronized: boolean); begin end; procedure TExtToolParser.ConsistencyCheck; begin end; class function TExtToolParser.IsSubTool(const SubTool: string): boolean; begin Result:=CompareText(DefaultSubTool,SubTool)=0; end; class function TExtToolParser.GetMsgExample(SubTool: string; MsgID: integer ): string; begin Result:=''; end; class function TExtToolParser.GetMsgHint(SubTool: string; MsgID: integer ): string; begin Result:=''; end; class function TExtToolParser.GetMsgParser(Msg: TMessageLine; ParserClass: TClass): TExtToolParser; var aTool: TAbstractExternalTool; begin Result:=nil; if ExternalToolList=nil then exit; aTool:=ExternalToolList.GetMsgTool(Msg); if aTool=nil then exit; Result:=aTool.FindParser(TExtToolParserClass(ParserClass)); end; class function TExtToolParser.Priority: integer; begin Result:=0; end; { TIDEExternalTools } // inline function TIDEExternalTools.GetItems(Index: integer): TAbstractExternalTool; begin Result:=TAbstractExternalTool(fItems[Index]); end; // inline function TIDEExternalTools.Count: integer; begin Result:=fItems.Count; end; constructor TIDEExternalTools.Create(aOwner: TComponent); begin inherited Create(aOwner); fItems:=TFPList.Create; end; destructor TIDEExternalTools.Destroy; begin inherited Destroy; FreeAndNil(fItems); if ExternalToolList=Self then ExternalToolList:=nil; end; procedure TIDEExternalTools.ConsistencyCheck; var i: Integer; begin for i:=0 to Count-1 do Items[i].ConsistencyCheck; end; function TIDEExternalTools.GetMsgExample(SubTool: string; MsgID: integer ): string; var Parser: TExtToolParserClass; i: Integer; begin Result:=''; for i:=0 to ParserCount-1 do begin Parser:=Parsers[i]; Result:=Parser.GetMsgExample(SubTool,MsgID); if Result<>'' then exit; end; end; function TIDEExternalTools.GetMsgHint(SubTool: string; MsgID: integer): string; var Parser: TExtToolParserClass; i: Integer; begin Result:=''; for i:=0 to ParserCount-1 do begin Parser:=Parsers[i]; Result:=Parser.GetMsgHint(SubTool,MsgID); if Result<>'' then exit; end; end; { TMessageLines } function TMessageLines.GetItems(Index: integer): TMessageLine; begin Result:=TMessageLine(fItems[Index]); end; procedure TMessageLines.SetBaseDirectory(const AValue: string); var NewValue: String; begin NewValue:=CleanAndExpandDirectory(AValue); if FBaseDirectory=NewValue then exit; FBaseDirectory:=NewValue; IncreaseChangeStamp; end; procedure TMessageLines.LineChanged(Line: TMessageLine); begin IncreaseChangeStamp; if fChangedHandler<>nil then fChangedHandler.CallNotifyEvents(Line); end; constructor TMessageLines.Create(aOwner: TObject; aMsgLineClass: TMessageLineClass); begin FOwner:=aOwner; InitCriticalSection(FCritSec); FMessageLineClass:=aMsgLineClass; fItems:=TFPList.Create; FSortedForSrcPos:=TAvgLvlTree.Create(@CompareMsgLinesSrcPos); FUpdateSortedSrcPos:=true; fChangedHandler:=TMethodList.Create; end; destructor TMessageLines.Destroy; begin EnterCriticalSection; try Clear; FreeAndNil(FSortedForSrcPos); FreeAndNil(fItems); inherited Destroy; FreeAndNil(fChangedHandler); finally LeaveCriticalsection; end; DoneCriticalsection(FCritSec); end; procedure TMessageLines.EnterCriticalSection; begin System.EnterCriticalsection(FCritSec); end; procedure TMessageLines.LeaveCriticalSection; begin System.LeaveCriticalsection(FCritSec); end; function TMessageLines.Count: integer; begin Result:=fItems.Count; end; procedure TMessageLines.Clear; var i: Integer; c: TMessageLineUrgency; begin if fItems.Count=0 then exit; FreeAndNil(fMarkedFixed); for i:=0 to fItems.Count-1 do TObject(fItems[i]).Free; fItems.Clear; FSortedForSrcPos.Clear; for c:=low(UrgencyCounts) to high(UrgencyCounts) do UrgencyCounts[c]:=0; IncreaseChangeStamp; end; function TMessageLines.GetLastLine: TMessageLine; begin if Count>0 then Result:=Items[Count-1] else Result:=nil; end; function TMessageLines.CreateLine(OutputIndex: integer): TMessageLine; begin Result:=MessageLineClass.Create; Result.FIndex:=-1; Result.FOutputIndex:=OutputIndex; end; procedure TMessageLines.Add(MsgLine: TMessageLine); begin if MsgLine.Index>=0 then raise Exception.Create('TMessageLines.Add already added'); MsgLine.FLines:=Self; MsgLine.FIndex:=fItems.Add(MsgLine); FSortedForSrcPos.Add(MsgLine); inc(UrgencyCounts[MsgLine.Urgency]); LineChanged(MsgLine); end; procedure TMessageLines.Remove(MsgLine: TMessageLine); var i: Integer; begin if MsgLine.FLines<>Self then raise Exception.Create(''); FSortedForSrcPos.Remove(MsgLine); fItems.Delete(MsgLine.Index); for i:=MsgLine.Index to Count-1 do Items[i].FIndex:=i; MsgLine.FLines:=nil; dec(UrgencyCounts[MsgLine.Urgency]); IncreaseChangeStamp; end; procedure TMessageLines.Delete(MsgLine: TMessageLine); begin Remove(MsgLine); MsgLine.Free; end; procedure TMessageLines.MarkFixed(MsgLine: TMessageLine); begin //debugln(['TMessageLines.MarkFixed ',MsgLine.Msg,' ',MsgLine.Line,',',MsgLine.Column]); if fMarkedFixed=nil then fMarkedFixed:=TAvgLvlTree.Create; if fMarkedFixed.Find(MsgLine)=nil then fMarkedFixed.Add(MsgLine); end; procedure TMessageLines.ApplyFixedMarks; var Node: TAvgLvlTreeNode; Msg: TMessageLine; List: TFPList; begin //debugln(['TMessageLines.ApplyFixedMarks ']); if fMarkedFixed=nil then exit; List:=TFPList.Create; try for Node in fMarkedFixed do begin Msg:=TMessageLine(Node.Data); if mlfFixed in Msg.Flags then Continue; Msg.Flags:=Msg.Flags+[mlfFixed]; List.Add(Msg); end; if List.Count=0 then exit; if Assigned(OnMarksFixed) then OnMarksFixed(List); finally FreeAndNil(fMarkedFixed); List.Free; end; end; procedure TMessageLines.FetchAll(SrcLines: TMessageLines); var i: Integer; u: TMessageLineUrgency; MsgLine: TMessageLine; begin if (SrcLines=nil) or (SrcLines=Self) or (SrcLines.Count=0) then exit; SrcLines.FSortedForSrcPos.Clear; for i:=0 to SrcLines.Count-1 do begin MsgLine:=SrcLines[i]; //debugln(['TMessageLines.FetchAll ',MsgLine.Msg]); MsgLine.FLines:=Self; MsgLine.FIndex:=fItems.Add(MsgLine); FSortedForSrcPos.Add(MsgLine); inc(UrgencyCounts[MsgLine.Urgency]); LineChanged(MsgLine); end; SrcLines.fItems.Clear; for u:=low(TMessageLineUrgency) to high(TMessageLineUrgency) do SrcLines.UrgencyCounts[u]:=0; IncreaseChangeStamp; end; procedure TMessageLines.SourceLinesInserted(Filename: string; Line, InsertedCount: integer); // adjust Line numbers in all messages var CmpLine: TMessageLine; Node: TAvgLvlTreeNode; MsgLine: TMessageLine; begin if (Filename='') or (Count<=0) then exit; CmpLine:=TMessageLine.Create; try CmpLine.Filename:=Filename; CmpLine.Line:=Line; Node:=FSortedForSrcPos.FindNearest(CmpLine); if Node=nil then exit; Node:=FSortedForSrcPos.FindLeftMost(CmpLine); // Note: if no exact node was found, Node can be one too less or too high if FSortedForSrcPos.Compare(Node,CmpLine)<0 then Node:=FSortedForSrcPos.FindSuccessor(Node); // adjust line numbers behind (in same source) CmpLine.Line:=High(integer); while (Node<>nil) and (FSortedForSrcPos.Compare(Node,CmpLine)<0) do begin MsgLine:=TMessageLine(Node.Data); inc(MsgLine.FLine,InsertedCount); LineChanged(MsgLine); Node:=FSortedForSrcPos.FindSuccessor(Node); end; finally CmpLine.Free; end; end; procedure TMessageLines.SourceLinesDeleted(Filename: string; FirstLine, DeletedCount: integer); // adjust Line numbers in all messages and mark lines in range as deleted var CmpLine: TMessageLine; Node: TAvgLvlTreeNode; MsgLine: TMessageLine; begin if (Filename='') or (Count<=0) then exit; CmpLine:=TMessageLine.Create; try CmpLine.Filename:=Filename; CmpLine.Line:=FirstLine; Node:=FSortedForSrcPos.FindNearest(CmpLine); if Node=nil then exit; Node:=FSortedForSrcPos.FindLeftMost(CmpLine); // Note: if no exact node was found, Node can be one too less or too high if FSortedForSrcPos.Compare(Node,CmpLine)<0 then Node:=FSortedForSrcPos.FindSuccessor(Node); // mark lines as deleted CmpLine.Line:=FirstLine+DeletedCount; while (Node<>nil) and (FSortedForSrcPos.Compare(Node,CmpLine)<0) do begin MsgLine:=TMessageLine(Node.Data); MsgLine.Flags:=MsgLine.Flags+[mlfFixed]; Node:=FSortedForSrcPos.FindSuccessor(Node); end; // adjust line numbers behind (in same source) CmpLine.Line:=High(integer); while (Node<>nil) and (FSortedForSrcPos.Compare(Node,CmpLine)<0) do begin MsgLine:=TMessageLine(Node.Data); dec(MsgLine.FLine,DeletedCount); LineChanged(MsgLine); Node:=FSortedForSrcPos.FindSuccessor(Node); end; finally CmpLine.Free; end; end; procedure TMessageLines.IncreaseChangeStamp; begin LUIncreaseChangeStamp64(FChangeStamp); end; function TMessageLines.IndexOfOutputIndex(OutputIndex: integer): integer; var l: Integer; r: Integer; CurOutputIndex: Integer; begin l:=0; r:=Count-1; while (l<=r) do begin Result:=(l+r) div 2; CurOutputIndex:=Items[Result].OutputIndex; if CurOutputIndex>OutputIndex then r:=Result-1 else if CurOutputIndexnil) and (FLines.BaseDirectory<>'') then AValue:=AppendPathDelim(FLines.BaseDirectory)+AValue; end; if FFilename=AValue then exit; SortedSrcPosUnbind; FFilename:=AValue; SortedSrcPosBind; IncreaseChangeStamp; end; procedure TMessageLine.SetFlags(AValue: TMessageLineFlags); begin if FFlags=AValue then Exit; FFlags:=AValue; IncreaseChangeStamp; end; procedure TMessageLine.SetLine(const AValue: integer); begin if FLine=AValue then exit; SortedSrcPosUnbind; FLine:=AValue; SortedSrcPosBind; IncreaseChangeStamp; end; procedure TMessageLine.SortedSrcPosBind; begin if (Index>=0) and Lines.UpdateSortedSrcPos then Lines.FSortedForSrcPos.Add(Self); end; procedure TMessageLine.SortedSrcPosUnbind; begin if (Index>=0) and Lines.UpdateSortedSrcPos then Lines.FSortedForSrcPos.Remove(Self); end; procedure TMessageLine.SetLines(AValue: TMessageLines); begin if FLines=AValue then exit; if FLines<>nil then begin SortedSrcPosUnbind; FLines.Remove(Self); end; FLines:=AValue; if FLines<>nil then begin FLines.Add(Self); if (not FilenameIsAbsolute(FFilename)) and (Lines.BaseDirectory<>'') then FFilename:=AppendPathDelim(Lines.BaseDirectory)+FFilename; SortedSrcPosBind; end else FLines:=nil; end; procedure TMessageLine.SetMsg(AValue: string); begin if FMsg=AValue then Exit; FMsg:=AValue; IncreaseChangeStamp; end; procedure TMessageLine.SetMsgID(AValue: integer); begin if FMsgID=AValue then Exit; FMsgID:=AValue; IncreaseChangeStamp; end; procedure TMessageLine.SetSubTool(AValue: string); begin if FSubTool=AValue then Exit; FSubTool:=AValue; IncreaseChangeStamp; end; procedure TMessageLine.SetSubType(AValue: PtrUInt); begin if FSubType=AValue then Exit; FSubType:=AValue; IncreaseChangeStamp; end; procedure TMessageLine.SetTranslatedMsg(AValue: string); begin if FTranslatedMsg=AValue then Exit; FTranslatedMsg:=AValue; IncreaseChangeStamp; end; procedure TMessageLine.SetUrgency(AValue: TMessageLineUrgency); begin if FUrgency=AValue then Exit; if Index>=0 then dec(Lines.UrgencyCounts[Urgency]); FUrgency:=AValue; if Index>=0 then inc(Lines.UrgencyCounts[Urgency]); IncreaseChangeStamp; end; constructor TMessageLine.Create; begin inherited Create; FIndex:=-1; FOutputIndex:=-1; IncreaseChangeStamp; end; destructor TMessageLine.Destroy; begin FreeAndNil(fAttributes); inherited Destroy; end; procedure TMessageLine.Assign(Source: TMessageLine); begin if Source.fAttributes<>nil then begin if fAttributes=nil then fAttributes:=TStringList.Create; fAttributes.Assign(Source.fAttributes); end else begin FreeAndNil(fAttributes); end; Urgency:=Source.Urgency; Column:=Source.Column; Filename:=Source.Filename; Flags:=Source.Flags; Line:=Source.Line; Msg:=Source.Msg; MsgID:=Source.MsgID; fOutputIndex:=Source.OutputIndex; SubTool:=Source.SubTool; SubType:=Source.SubType; TranslatedMsg:=Source.TranslatedMsg; IncreaseChangeStamp; end; function TMessageLine.Equals(Obj: TObject): boolean; var Source: TMessageLine; begin if Obj is TMessageLine then begin Source:=TMessageLine(Obj); Result:=false; if Source.fAttributes<>nil then begin if fAttributes=nil then exit; if not fAttributes.Equals(Source.fAttributes) then exit; end else begin if (fAttributes<>nil) and (fAttributes.Count>0) then exit; end; Result:=(Urgency=Source.Urgency) and (Column=Source.Column) and (Filename=Source.Filename) and (Flags=Source.Flags) and (Line=Source.Line) and (Msg=Source.Msg) and (MsgID=Source.MsgID) and (fOutputIndex=Source.OutputIndex) and (SubTool=Source.SubTool) and (SubType=Source.SubType) and (TranslatedMsg=Source.TranslatedMsg); end else Result:=inherited Equals(Obj); end; procedure TMessageLine.Clear; begin SubTool:=''; Msg:=''; TranslatedMsg:=''; Filename:=''; FreeAndNil(fAttributes); end; function TMessageLine.GetRelativeFilename: string; begin Result:=FFilename; if (Lines<>nil) and (Lines.BaseDirectory<>'') then Result:=CreateRelativePath(Result,FLines.BaseDirectory); end; procedure TMessageLine.ShareStrings(const ShareStringEvent: TETShareStringEvent ); var i: Integer; s: String; begin ShareStringEvent(FFilename); ShareStringEvent(FMsg); ShareStringEvent(FTranslatedMsg); ShareStringEvent(FSubTool); if fAttributes<>nil then begin for i:=0 to fAttributes.Count-1 do begin s:=fAttributes[i]; ShareStringEvent(s); fAttributes[i]:=s; end; end; end; procedure TMessageLine.SetSourcePosition(NewFilename: string; NewLine, NewColumn: integer); begin NewFilename:=TrimFilename(NewFilename); if (FFilename=NewFilename) and (NewLine=Line) and (NewColumn=Column) then exit; SortedSrcPosUnbind; FFilename:=NewFilename; FLine:=NewLine; FColumn:=NewColumn; SortedSrcPosBind; IncreaseChangeStamp; end; procedure TMessageLine.IncreaseChangeStamp; begin if Lines<>nil then begin Lines.LineChanged(Self); FChangeStamp:=Lines.ChangeStamp; end else LUIncreaseChangeStamp64(FChangeStamp); end; procedure TMessageLine.MarkFixed; begin Lines.MarkFixed(Self); end; function TMessageLine.HasSourcePosition: boolean; begin Result:=(Line>0) and (Column>0) and (GetFullFilename<>''); end; procedure TMessageLine.GetAttributes(List: TStrings); begin List.Assign(fAttributes); List.Values['Urgency']:=MessageLineUrgencyNames[Urgency]; List.Values['SubTool']:=SubTool; List.Values['SubType']:=IntToStr(SubType); List.Values['File']:=Filename; List.Values['Line']:=IntToStr(Line); List.Values['Col']:=IntToStr(Column); List.Values['Msg']:=Msg; List.Values['MsgID']:=IntToStr(MsgID); List.Values['OriginalLine']:=OriginalLine; end; { TExtToolView } procedure TExtToolView.FetchAllPending; begin Lines.FetchAll(PendingLines); end; procedure TExtToolView.ToolExited; begin end; procedure TExtToolView.CreateLines; begin FLines:=TMessageLines.Create(Self, FMessageLineClass); FProgressLine:=FMessageLineClass.Create; FPendingLines:=TMessageLines.Create(Self, FMessageLineClass); FPendingProgressLine:=FMessageLineClass.Create; end; constructor TExtToolView.Create(AOwner: TComponent); begin inherited Create(AOwner); if FMessageLineClass=nil then FMessageLineClass:=TMessageLine; CreateLines; FRunning:=true; FMinUrgency:=DefaultETViewMinUrgency; FLastWorkerMessageCount:=-1; end; destructor TExtToolView.Destroy; begin // wait for other threads to finish their access EnterCriticalSection; try RemoveAsyncOnChanged; ClearLines; FreeAndNil(FProgressLine); FreeAndNil(FPendingLines); FreeAndNil(FPendingProgressLine); inherited Destroy; finally LeaveCriticalSection; end; FreeAndNil(FLines); end; procedure TExtToolView.ProcessNewMessages(AThread: TThread); { Called by TExternalTool.AddOutputLines Tool is in Critical section } var i: Integer; SrcMsg: TMessageLine; NewMsg: TMessageLine; Changed: Boolean; NewProgressLine: TMessageLine; begin if csDestroying in ComponentState then exit; Changed:=false; EnterCriticalSection; // Beware: Tool is already in critical section try if (FPendingLines=nil) or (FPendingProgressLine=nil) then exit; //DebugLn(['TExtToolView.ProcessNewMessages START From=',FirstMsgLine,' To=',Tool.WorkerMessages.Count-1]); NewProgressLine:=nil; for i:=FLastWorkerMessageCount+1 to Tool.WorkerMessages.Count-1 do begin SrcMsg:=Tool.WorkerMessages[i]; //debugln(['TExtToolView.ProcessNewMessages Msg="',SrcMsg.Msg,'" Fits=',LineFits(SrcMsg)]); if LineFits(SrcMsg) then begin NewProgressLine:=nil; Changed:=true; NewMsg:=PendingLines.CreateLine(-1); NewMsg.Assign(SrcMsg); //debugln(['TExtToolView.ProcessNewMessages NewMsg=',Lines.Count,'="',NewMsg.Msg,'"']); PendingLines.Add(NewMsg); end else begin NewProgressLine:=SrcMsg; end; end; FLastWorkerMessageCount:=Tool.WorkerMessages.Count-1; if (NewProgressLine<>nil) and Running then begin Changed:=true; PendingProgressLine.Assign(NewProgressLine); end else if PendingProgressLine.Msg<>'' then begin Changed:=true; PendingProgressLine.Msg:=''; end; //debugln(['TExtToolView.ProcessNewMessages END Changed=',Changed,' Progress="',ProgressLine.Msg,'"']); finally LeaveCriticalSection; end; if Changed and Assigned(OnChanged) then begin // wake up main thread QueueAsyncOnChanged; end; end; procedure TExtToolView.ClearLines; var i: Integer; begin EnterCriticalSection; try FLastWorkerMessageCount:=-1; if Lines<>nil then Lines.Clear; if ProgressLine<>nil then ProgressLine.Clear; if PendingLines<>nil then begin for i:=0 to PendingLines.Count-1 do TObject(PendingLines[i]).Free; PendingLines.Clear; end; if PendingProgressLine<>nil then PendingProgressLine.Clear; finally LeaveCriticalSection; end; end; function TExtToolView.ApplyPending: boolean; // returns true if something changed begin Result:=false; if csDestroying in ComponentState then exit; EnterCriticalSection; try if csDestroying in ComponentState then exit; if PendingLines.Count>0 then begin FetchAllPending; Result:=true; end; if not ProgressLine.Equals(PendingProgressLine) then begin ProgressLine.Assign(PendingProgressLine); Result:=true; end; finally LeaveCriticalSection; end; end; procedure TExtToolView.InputClosed; begin if csDestroying in ComponentState then exit; if not Running then begin raise Exception.Create('TExtToolView.InputClosed already closed: '+Caption); end; FRunning:=false; EnterCriticalSection; try if csDestroying in ComponentState then exit; if PendingProgressLine.Msg<>'' then PendingProgressLine.Clear; finally LeaveCriticalSection; end; if Tool<>nil then ExitStatus:=Tool.ExitStatus; ToolExited; if Assigned(OnChanged) then begin RemoveAsyncOnChanged; OnChanged(Self); end; end; function TExtToolView.LineFits(Line: TMessageLine): boolean; begin Result:=(Line.Msg<>'') and (Line.Urgency>=MinUrgency); end; procedure TExtToolView.EnterCriticalSection; begin FLines.EnterCriticalSection; end; procedure TExtToolView.LeaveCriticalSection; begin FLines.LeaveCriticalSection; end; procedure TExtToolView.ConsistencyCheck; begin EnterCriticalSection; try FLines.ConsistencyCheck; FPendingLines.ConsistencyCheck; finally LeaveCriticalSection; end; end; function TExtToolView.HasFinished: boolean; begin Result:=false; EnterCriticalSection; try if Running then exit; if (Tool<>nil) and (Tool.Stage<>etsStopped) then exit; if PendingLines.Count>0 then exit; Result:=true; finally LeaveCriticalSection; end; end; end. {$ELSE EnableNewExtTools} interface uses Classes, SysUtils, LCLType, LazConfigStorage, Forms, Controls, BaseIDEIntf; { The xml format version: When the format changes (new values, changed formats) we can distinguish old files and are able to convert them. } const ExternalToolOptionsVersion = '2'; type TIDEExternalToolOptions = class; { TIDEScanMessageLine } TIDEScanMessageLine = class(TPersistent) private FCaller: TObject; FLine: string; FLineNumber: integer; FTool: TIDEExternalToolOptions; FWorkingDirectory: string; procedure SetLine(const AValue: string); procedure SetWorkingDirectory(const AValue: string); protected procedure SetTool(const AValue: TIDEExternalToolOptions); procedure SetLineNumber(const NewLineNumber: integer); procedure LineChanged(const OldValue: string); virtual; abstract; procedure WorkingDirectoryChanged(const OldValue: string); virtual; abstract; public constructor Create(TheCaller: TObject = nil; TheTool: TIDEExternalToolOptions = nil); property Caller: TObject read FCaller; property Line: string read FLine write SetLine; property WorkingDirectory: string read FWorkingDirectory write SetWorkingDirectory; property LineNumber: integer read FLineNumber; property Tool: TIDEExternalToolOptions read FTool; end; TOnIDEExtToolParseLine = procedure(Sender: TObject; Line: TIDEScanMessageLine) of object; { TIDEExternalToolOptions - the storage object for a single external tool } TIDEExternalToolOptions = class(TPersistent) private fCmdLineParams: string; FEnvironmentOverrides: TStringList; fFilename: string; FHideMainForm: boolean; FOnParseLine: TOnIDEExtToolParseLine; FScanners: TStrings; FScanOutput: boolean; fScanOutputForFPCMessages: boolean; fScanOutputForMakeMessages: boolean; FShowAllOutput: boolean; fTitle: string; fWorkingDirectory: string; procedure SetScanners(const AValue: TStrings); procedure SetScanOutput(const AValue: boolean); procedure SetShowAllOutput(const AValue: boolean); public constructor Create; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure Clear; virtual; function NeedsOutputFilter: boolean; function Load(Config: TConfigStorage): TModalResult; virtual; function Save(Config: TConfigStorage): TModalResult; virtual; function ShortDescription: string; procedure AssignEnvironmentTo(Strings: TStrings); procedure ParseLine(Sender: TObject; Line: TIDEScanMessageLine); virtual; property CmdLineParams: string read fCmdLineParams write fCmdLineParams; property Filename: string read fFilename write fFilename; property Title: string read fTitle write fTitle; property WorkingDirectory: string read fWorkingDirectory write fWorkingDirectory; property EnvironmentOverrides: TStringList read FEnvironmentOverrides; property ScanOutputForFPCMessages: boolean read fScanOutputForFPCMessages write fScanOutputForFPCMessages; property ScanOutputForMakeMessages: boolean read fScanOutputForMakeMessages write fScanOutputForMakeMessages; property ScanOutput: boolean read FScanOutput write SetScanOutput; property ShowAllOutput: boolean read FShowAllOutput write SetShowAllOutput; property OnParseLine: TOnIDEExtToolParseLine read FOnParseLine write FOnParseLine; property Scanners: TStrings read FScanners write SetScanners; property HideMainForm: boolean read FHideMainForm write FHideMainForm default true; end; type TRunExternalTool = function (Tool: TIDEExternalToolOptions): TModalResult of object; var RunExternalTool: TRunExternalTool = nil;// set by the IDE implementation { TIDEExternalToolOptions } procedure TIDEExternalToolOptions.SetScanOutput(const AValue: boolean); begin if FScanOutput=AValue then exit; FScanOutput:=AValue; end; procedure TIDEExternalToolOptions.SetScanners(const AValue: TStrings); begin if FScanners=AValue then exit; FScanners.Assign(AValue); end; procedure TIDEExternalToolOptions.SetShowAllOutput(const AValue: boolean); begin if FShowAllOutput=AValue then exit; FShowAllOutput:=AValue; end; procedure TIDEExternalToolOptions.Assign(Source: TPersistent); var Src: TIDEExternalToolOptions; begin if Source=Self then exit; if Source is TIDEExternalToolOptions then begin Src:=TIDEExternalToolOptions(Source); fTitle:=Src.fTitle; fFilename:=Src.fFilename; fCmdLineParams:=Src.fCmdLineParams; fWorkingDirectory:=Src.fWorkingDirectory; fScanOutputForFPCMessages:=Src.fScanOutputForFPCMessages; fScanOutputForMakeMessages:=Src.fScanOutputForMakeMessages; FScanOutput:=Src.FScanOutput; FShowAllOutput:=Src.FShowAllOutput; FScanners.Assign(Src.FScanners); FHideMainForm:=Src.HideMainForm; end else inherited Assign(Source); end; constructor TIDEExternalToolOptions.Create; begin inherited Create; FEnvironmentOverrides:=TStringList.Create; FScanners:=TStringList.Create; FHideMainForm:=true; Clear; end; destructor TIDEExternalToolOptions.Destroy; begin FreeAndNil(FEnvironmentOverrides); FreeAndNil(FScanners); inherited Destroy; end; procedure TIDEExternalToolOptions.Clear; begin fTitle:=''; fFilename:=''; fCmdLineParams:=''; fWorkingDirectory:=''; fScanOutputForFPCMessages:=false; fScanOutputForMakeMessages:=false; FScanOutput:=false; FShowAllOutput:=false; FHideMainForm:=true; FEnvironmentOverrides.Clear; FScanners.Clear; end; function TIDEExternalToolOptions.Load(Config: TConfigStorage): TModalResult; begin Clear; fTitle:=Config.GetValue('Title/Value',''); fFilename:=Config.GetValue('Filename/Value',''); fCmdLineParams:=Config.GetValue('CmdLineParams/Value',''); fWorkingDirectory:=Config.GetValue('WorkingDirectory/Value',''); fScanOutputForFPCMessages:=Config.GetValue( 'ScanOutputForFPCMessages/Value',false); fScanOutputForMakeMessages:=Config.GetValue( 'ScanOutputForMakeMessages/Value',false); FShowAllOutput:=Config.GetValue('ShowAllOutput/Value',false); FHideMainForm:=Config.GetValue('HideMainForm/Value',true); Config.GetValue('EnvironmentOverrides/',FEnvironmentOverrides); Config.GetValue('Scanners/',FScanners); Result:=mrOk; end; function TIDEExternalToolOptions.Save(Config: TConfigStorage): TModalResult; begin Config.SetValue('Format/Version',ExternalToolOptionsVersion); Config.SetDeleteValue('Title/Value',fTitle,''); Config.SetDeleteValue('Filename/Value',fFilename,''); Config.SetDeleteValue('CmdLineParams/Value',fCmdLineParams,''); Config.SetDeleteValue('WorkingDirectory/Value',fWorkingDirectory,''); Config.SetDeleteValue( 'ScanOutputForFPCMessages/Value',fScanOutputForFPCMessages, false); Config.SetDeleteValue( 'ScanOutputForMakeMessages/Value',fScanOutputForMakeMessages, false); Config.SetDeleteValue('ShowAllOutput/Value',FShowAllOutput,false); Config.SetDeleteValue('HideMainForm/Value',FHideMainForm,true); Config.SetValue('EnvironmentOverrides/',FEnvironmentOverrides); Config.SetValue('Scanners/',FScanners); Result:=mrOk; end; function TIDEExternalToolOptions.ShortDescription: string; begin Result:=Title; end; procedure TIDEExternalToolOptions.AssignEnvironmentTo(Strings: TStrings); begin BaseIDEIntf.AssignEnvironmentTo(Strings,EnvironmentOverrides); end; procedure TIDEExternalToolOptions.ParseLine(Sender: TObject; Line: TIDEScanMessageLine); begin if Assigned(OnParseLine) then OnParseLine(Sender,Line); end; function TIDEExternalToolOptions.NeedsOutputFilter: boolean; begin Result:=ScanOutput or ScanOutputForFPCMessages or ScanOutputForMakeMessages or ShowAllOutput or ((FScanners<>nil) and (FScanners.Count>0)); end; { TIDEScanMessageLine } procedure TIDEScanMessageLine.SetLine(const AValue: string); var OldLine: String; begin if FLine=AValue then exit; OldLine:=FLine; FLine:=AValue; LineChanged(OldLine); end; procedure TIDEScanMessageLine.SetWorkingDirectory(const AValue: string); var OldDir: String; begin if FWorkingDirectory=AValue then exit; OldDir:=FWorkingDirectory; FWorkingDirectory:=AValue; WorkingDirectoryChanged(OldDir); end; procedure TIDEScanMessageLine.SetTool(const AValue: TIDEExternalToolOptions); begin FTool:=AValue; end; procedure TIDEScanMessageLine.SetLineNumber(const NewLineNumber: integer); begin FLineNumber:=NewLineNumber; end; constructor TIDEScanMessageLine.Create(TheCaller: TObject; TheTool: TIDEExternalToolOptions); begin FCaller:=TheCaller; FTool:=TheTool; end; end. {$ENDIF}