mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-16 23:49:28 +02:00
IDE: editor for additions to the fpc messages
git-svn-id: trunk@35164 -
This commit is contained in:
mattias
parent
8f58e393e4
commit
b4ee012f66
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -3106,6 +3106,7 @@ docs/LazarusIDEInternals.pdf -text svneol=unset#application/pdf
|
||||
docs/RemoteDebugging.txt svneol=native#text/plain
|
||||
docs/SVN.txt svneol=native#text/plain
|
||||
docs/acknowledgements.txt svneol=native#text/plain
|
||||
docs/additionalmsghelp.xml svneol=native#text/plain
|
||||
docs/booth/ProdProgEntwMitOpenSourceSystems2007.odp -text
|
||||
docs/contributors.utf8 svneol=native#text/plain
|
||||
docs/html/Makefile svneol=native#text/plain
|
||||
|
||||
6
docs/additionalmsghelp.xml
Normal file
6
docs/additionalmsghelp.xml
Normal file
@ -0,0 +1,6 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<Additions Count="1">
|
||||
<Item1 IDs="10022" URL="Unit_not_found_-_How_to_find_units" Name="Can not find unit"/>
|
||||
</Additions>
|
||||
</CONFIG>
|
||||
@ -7,6 +7,7 @@ object EditIDEMsgHelpDialog: TEditIDEMsgHelpDialog
|
||||
ClientHeight = 522
|
||||
ClientWidth = 649
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '0.9.31'
|
||||
object CurMsgGroupBox: TGroupBox
|
||||
@ -48,6 +49,7 @@ object EditIDEMsgHelpDialog: TEditIDEMsgHelpDialog
|
||||
CancelButton.Name = 'CancelButton'
|
||||
CancelButton.DefaultCaption = True
|
||||
TabOrder = 1
|
||||
OnClick = ButtonPanel1Click
|
||||
ShowButtons = [pbOK, pbCancel, pbHelp]
|
||||
end
|
||||
object AllGroupBox: TGroupBox
|
||||
@ -61,13 +63,14 @@ object EditIDEMsgHelpDialog: TEditIDEMsgHelpDialog
|
||||
ClientHeight = 247
|
||||
ClientWidth = 273
|
||||
TabOrder = 2
|
||||
object URLsListBox: TListBox
|
||||
object AllListBox: TListBox
|
||||
Left = 0
|
||||
Height = 221
|
||||
Top = 0
|
||||
Width = 273
|
||||
Align = alClient
|
||||
ItemHeight = 0
|
||||
OnSelectionChange = AllListBoxSelectionChange
|
||||
ScrollWidth = 271
|
||||
TabOrder = 0
|
||||
TopIndex = -1
|
||||
@ -80,6 +83,7 @@ object EditIDEMsgHelpDialog: TEditIDEMsgHelpDialog
|
||||
Align = alBottom
|
||||
AutoSize = True
|
||||
Caption = 'AddButton'
|
||||
OnClick = AddButtonClick
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
@ -95,16 +99,18 @@ object EditIDEMsgHelpDialog: TEditIDEMsgHelpDialog
|
||||
ClientWidth = 339
|
||||
TabOrder = 3
|
||||
object DeleteButton: TButton
|
||||
AnchorSideLeft.Control = CurGroupBox
|
||||
AnchorSideLeft.Control = TestURLButton
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = URLEdit
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Left = 104
|
||||
Height = 26
|
||||
Top = 171
|
||||
Top = 192
|
||||
Width = 84
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'DeleteButton'
|
||||
OnClick = DeleteButtonClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object NameLabel: TLabel
|
||||
@ -131,18 +137,19 @@ object EditIDEMsgHelpDialog: TEditIDEMsgHelpDialog
|
||||
Width = 257
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 6
|
||||
OnChange = NameEditChange
|
||||
TabOrder = 1
|
||||
Text = 'NameEdit'
|
||||
end
|
||||
object URLLabel: TLabel
|
||||
AnchorSideLeft.Control = CurGroupBox
|
||||
AnchorSideTop.Control = OnlyRegExEdit
|
||||
AnchorSideTop.Control = AdditionFitsMsgLabel
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = CurGroupBox
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 15
|
||||
Top = 126
|
||||
Top = 147
|
||||
Width = 327
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 6
|
||||
@ -160,12 +167,13 @@ object EditIDEMsgHelpDialog: TEditIDEMsgHelpDialog
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 24
|
||||
Top = 141
|
||||
Top = 162
|
||||
Width = 327
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Right = 6
|
||||
BorderSpacing.Bottom = 6
|
||||
OnChange = URLEditChange
|
||||
TabOrder = 2
|
||||
Text = 'URLEdit'
|
||||
end
|
||||
@ -201,6 +209,7 @@ object EditIDEMsgHelpDialog: TEditIDEMsgHelpDialog
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Right = 6
|
||||
BorderSpacing.Bottom = 6
|
||||
OnChange = OnlyFPCMsgIDsEditChange
|
||||
TabOrder = 3
|
||||
Text = 'OnlyFPCMsgIDsEdit'
|
||||
end
|
||||
@ -236,9 +245,37 @@ object EditIDEMsgHelpDialog: TEditIDEMsgHelpDialog
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Right = 6
|
||||
BorderSpacing.Bottom = 6
|
||||
OnChange = OnlyRegExEditChange
|
||||
TabOrder = 4
|
||||
Text = 'OnlyRegExEdit'
|
||||
end
|
||||
object AdditionFitsMsgLabel: TLabel
|
||||
AnchorSideLeft.Control = CurGroupBox
|
||||
AnchorSideTop.Control = OnlyRegExEdit
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 15
|
||||
Top = 126
|
||||
Width = 116
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'AdditionFitsMsgLabel'
|
||||
ParentColor = False
|
||||
WordWrap = True
|
||||
end
|
||||
object TestURLButton: TButton
|
||||
AnchorSideLeft.Control = CurGroupBox
|
||||
AnchorSideTop.Control = URLEdit
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 26
|
||||
Top = 192
|
||||
Width = 92
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'TestURLButton'
|
||||
OnClick = TestURLButtonClick
|
||||
TabOrder = 5
|
||||
end
|
||||
end
|
||||
object Splitter1: TSplitter
|
||||
Left = 289
|
||||
@ -274,11 +311,15 @@ object EditIDEMsgHelpDialog: TEditIDEMsgHelpDialog
|
||||
AnchorSideLeft.Control = FPCMsgFileLabel
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = GlobalOptionsGroupBox
|
||||
AnchorSideRight.Control = GlobalOptionsGroupBox
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 104
|
||||
Height = 24
|
||||
Top = 6
|
||||
Width = 283
|
||||
Width = 523
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 6
|
||||
OnEditingDone = FPCMsgFileEditEditingDone
|
||||
TabOrder = 0
|
||||
Text = 'FPCMsgFileEdit'
|
||||
end
|
||||
@ -299,10 +340,13 @@ object EditIDEMsgHelpDialog: TEditIDEMsgHelpDialog
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = FPCMsgFileEdit
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = GlobalOptionsGroupBox
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 112
|
||||
Height = 24
|
||||
Top = 36
|
||||
Width = 280
|
||||
Width = 515
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 6
|
||||
TabOrder = 1
|
||||
Text = 'AdditionsFileEdit'
|
||||
|
||||
@ -38,23 +38,43 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fgl, LCLProc, Dialogs, FileUtil, TextTools, MacroIntf,
|
||||
LazarusIDEStrConsts, LazConfigStorage, HelpIntfs, IDEHelpIntf, LazHelpIntf,
|
||||
LazHelpHTML, StdCtrls, ButtonPanel, ExtCtrls, Forms, CodeToolsFPCMsgs,
|
||||
FileProcs, CodeToolManager, CodeCache;
|
||||
LazarusIDEStrConsts, LazConfigStorage, HelpIntfs, IDEHelpIntf, BaseIDEIntf,
|
||||
IDEMsgIntf, IDEDialogs, LazHelpIntf, LazHelpHTML, StdCtrls, ButtonPanel,
|
||||
ExtCtrls, Forms, Controls, Graphics, LCLIntf, CodeToolsFPCMsgs, FileProcs,
|
||||
CodeToolManager, CodeCache;
|
||||
|
||||
const
|
||||
lihcFPCMessages = 'FreePascal Compiler messages';
|
||||
lihFPCMessagesURL = 'http://wiki.lazarus.freepascal.org/';
|
||||
|
||||
type
|
||||
|
||||
{ TMessageHelpAddition }
|
||||
|
||||
TMessageHelpAddition = class
|
||||
public
|
||||
Name: string;
|
||||
URL: string;
|
||||
RegEx: string;
|
||||
IDs: string; // comma separated
|
||||
procedure Assign(Source: TMessageHelpAddition);
|
||||
function IsEqual(Source: TMessageHelpAddition): boolean;
|
||||
function Fits(ID: integer; Msg: string): boolean;
|
||||
end;
|
||||
TBaseMessageHelpAdditions = specialize TFPGObjectList<TMessageHelpAddition>;
|
||||
|
||||
{ TMessageHelpAdditions }
|
||||
|
||||
TMessageHelpAdditions = class(TBaseMessageHelpAdditions)
|
||||
public
|
||||
function FindWithName(Name: string): TMessageHelpAddition;
|
||||
function IsEqual(Source: TMessageHelpAdditions): boolean;
|
||||
procedure Clone(Source: TMessageHelpAdditions);
|
||||
procedure LoadFromConfig(Cfg: TConfigStorage);
|
||||
procedure SaveToConfig(Cfg: TConfigStorage);
|
||||
procedure LoadFromFile(Filename: string);
|
||||
procedure SaveToFile(Filename: string);
|
||||
end;
|
||||
TMessageHelpAdditions = specialize TFPGObjectList<TMessageHelpAddition>;
|
||||
|
||||
{ TFPCMessagesHelpDatabase }
|
||||
|
||||
@ -64,10 +84,12 @@ type
|
||||
FAdditionsChangeStep: integer;
|
||||
FAdditionsFile: string;
|
||||
FDefaultAdditionsFile: string;
|
||||
FFoundAddition: TMessageHelpAddition;
|
||||
FFPCTranslationFile: string;
|
||||
FDefaultNode: THelpNode;
|
||||
FFoundComment: string;
|
||||
FLastMessage: string;
|
||||
FLoadedAdditionsFilename: string;
|
||||
FMsgFile: TFPCMsgFile;
|
||||
FMsgFileChangeStep: integer;
|
||||
FMsgFilename: string;
|
||||
@ -90,6 +112,7 @@ type
|
||||
property DefaultNode: THelpNode read FDefaultNode;
|
||||
property LastMessage: string read FLastMessage write SetLastMessage;
|
||||
property FoundComment: string read FFoundComment write SetFoundComment;
|
||||
property FoundAddition: TMessageHelpAddition read FFoundAddition;
|
||||
|
||||
// the FPC message file
|
||||
function GetMsgFile: TFPCMsgFile;
|
||||
@ -102,6 +125,11 @@ type
|
||||
property Additions[Index: integer]: TMessageHelpAddition read GetAdditions;
|
||||
property AdditionsChangeStep: integer read FAdditionsChangeStep;
|
||||
property DefaultAdditionsFile: string read FDefaultAdditionsFile;
|
||||
property LoadedAdditionsFilename: string read FLoadedAdditionsFilename;
|
||||
procedure ClearAdditions;
|
||||
procedure LoadAdditions;
|
||||
procedure SaveAdditions;
|
||||
function GetAdditionsFilename: string;
|
||||
published
|
||||
property AdditionsFile: string read FAdditionsFile write SetAdditionsFile;
|
||||
property FPCTranslationFile: string read FFPCTranslationFile
|
||||
@ -112,6 +140,7 @@ type
|
||||
|
||||
TEditIDEMsgHelpDialog = class(TForm)
|
||||
AddButton: TButton;
|
||||
AdditionFitsMsgLabel: TLabel;
|
||||
AdditionsFileEdit: TEdit;
|
||||
AdditionsFileLabel: TLabel;
|
||||
ButtonPanel1: TButtonPanel;
|
||||
@ -130,13 +159,42 @@ type
|
||||
OnlyRegExLabel: TLabel;
|
||||
Splitter1: TSplitter;
|
||||
AllGroupBox: TGroupBox;
|
||||
TestURLButton: TButton;
|
||||
URLEdit: TEdit;
|
||||
URLLabel: TLabel;
|
||||
URLsListBox: TListBox;
|
||||
AllListBox: TListBox;
|
||||
procedure AddButtonClick(Sender: TObject);
|
||||
procedure AllListBoxSelectionChange(Sender: TObject; User: boolean);
|
||||
procedure ButtonPanel1Click(Sender: TObject);
|
||||
procedure ButtonPanel1OKButtonClick(Sender: TObject);
|
||||
procedure DeleteButtonClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure FPCMsgFileEditEditingDone(Sender: TObject);
|
||||
procedure NameEditChange(Sender: TObject);
|
||||
procedure OnlyFPCMsgIDsEditChange(Sender: TObject);
|
||||
procedure OnlyRegExEditChange(Sender: TObject);
|
||||
procedure TestURLButtonClick(Sender: TObject);
|
||||
procedure URLEditChange(Sender: TObject);
|
||||
private
|
||||
fDefaultValue: string;
|
||||
procedure FillAdditionsList;
|
||||
procedure UpdateCurAddition;
|
||||
procedure UpdateCurMessage;
|
||||
procedure UpdateAdditionsFitsMsg;
|
||||
function IsIDListValid(IDs: string): boolean;
|
||||
function IsRegexValid(re: string): boolean;
|
||||
function IsURLValid(URL: string): boolean;
|
||||
public
|
||||
Additions: TMessageHelpAdditions;
|
||||
CurAddition: TMessageHelpAddition;
|
||||
CurMsg: string;
|
||||
CurFPCId: integer;
|
||||
end;
|
||||
|
||||
var
|
||||
FPCMsgHelpDB: TFPCMessagesHelpDatabase = nil;
|
||||
|
||||
function ShowMessageHelpEditor: TModalResult;
|
||||
|
||||
procedure CreateFPCMessagesHelpDB;
|
||||
@ -145,6 +203,8 @@ function AddFPCMessageHelpItem(const Title, URL, RegularExpression: string
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
function ShowMessageHelpEditor: TModalResult;
|
||||
var
|
||||
Editor: TEditIDEMsgHelpDialog;
|
||||
@ -159,19 +219,18 @@ end;
|
||||
|
||||
procedure CreateFPCMessagesHelpDB;
|
||||
var
|
||||
FPCHelp: TFPCMessagesHelpDatabase;
|
||||
StartNode: THelpNode;
|
||||
begin
|
||||
FPCMessagesHelpDB:=HelpDatabases.CreateHelpDatabase(lihcFPCMessages,
|
||||
TFPCMessagesHelpDatabase,true);
|
||||
FPCHelp:=FPCMessagesHelpDB as TFPCMessagesHelpDatabase;
|
||||
FPCHelp.DefaultBaseURL:=lihFPCMessagesURL;
|
||||
FPCMsgHelpDB:=FPCMessagesHelpDB as TFPCMessagesHelpDatabase;
|
||||
FPCMsgHelpDB.DefaultBaseURL:=lihFPCMessagesURL;
|
||||
|
||||
// HTML nodes
|
||||
StartNode:=THelpNode.CreateURLID(FPCHelp,'FreePascal Compiler messages',
|
||||
StartNode:=THelpNode.CreateURLID(FPCMsgHelpDB,'FreePascal Compiler messages',
|
||||
'file://Build_messages#FreePascal_Compiler_messages',lihcFPCMessages);
|
||||
FPCHelp.TOCNode:=THelpNode.Create(FPCHelp,StartNode);// once as TOC
|
||||
FPCHelp.RegisterItemWithNode(StartNode);// and once as normal page
|
||||
FPCMsgHelpDB.TOCNode:=THelpNode.Create(FPCMsgHelpDB,StartNode);// once as TOC
|
||||
FPCMsgHelpDB.RegisterItemWithNode(StartNode);// and once as normal page
|
||||
|
||||
// register messages
|
||||
AddFPCMessageHelpItem('Can''t find unit',
|
||||
@ -192,24 +251,587 @@ begin
|
||||
FPCMessagesHelpDB.RegisterItem(Result);
|
||||
end;
|
||||
|
||||
{ TMessageHelpAdditions }
|
||||
|
||||
function TMessageHelpAdditions.FindWithName(Name: string): TMessageHelpAddition;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to Count-1 do begin
|
||||
Result:=Items[i];
|
||||
if SysUtils.CompareText(Result.Name,Name)=0 then exit;
|
||||
end;
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TMessageHelpAdditions.IsEqual(Source: TMessageHelpAdditions): boolean;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result:=false;
|
||||
if Source=nil then exit;
|
||||
if Source=Self then exit(true);
|
||||
if Count<>Source.Count then exit;
|
||||
for i:=0 to Count-1 do
|
||||
if not Items[i].IsEqual(Source[i]) then exit;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure TMessageHelpAdditions.Clone(Source: TMessageHelpAdditions);
|
||||
var
|
||||
i: Integer;
|
||||
Item: TMessageHelpAddition;
|
||||
begin
|
||||
Clear;
|
||||
for i:=0 to Source.Count-1 do begin
|
||||
Item:=TMessageHelpAddition.Create;
|
||||
Item.Assign(Source[i]);
|
||||
Add(Item);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMessageHelpAdditions.LoadFromConfig(Cfg: TConfigStorage);
|
||||
var
|
||||
Cnt: Integer;
|
||||
i: Integer;
|
||||
Item: TMessageHelpAddition;
|
||||
SubPath: String;
|
||||
begin
|
||||
Clear;
|
||||
Cfg.AppendBasePath('Additions');
|
||||
try
|
||||
Cnt:=Cfg.GetValue('Count',0);
|
||||
for i:=1 to Cnt do begin
|
||||
Item:=TMessageHelpAddition.Create;
|
||||
SubPath:='Item'+IntToStr(i)+'/';
|
||||
Item.Name:=Cfg.GetValue(SubPath+'Name','');
|
||||
if Item.Name='' then begin
|
||||
Item.Free;
|
||||
end else begin
|
||||
Add(Item);
|
||||
Item.IDs:=cfg.GetValue(SubPath+'IDs','');
|
||||
Item.RegEx:=cfg.GetValue(SubPath+'RegEx','');
|
||||
Item.URL:=cfg.GetValue(SubPath+'URL','');
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Cfg.UndoAppendBasePath;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMessageHelpAdditions.SaveToConfig(Cfg: TConfigStorage);
|
||||
var
|
||||
Cnt: Integer;
|
||||
i: Integer;
|
||||
Item: TMessageHelpAddition;
|
||||
SubPath: String;
|
||||
begin
|
||||
Cfg.AppendBasePath('Additions');
|
||||
try
|
||||
Cnt:=0;
|
||||
for i:=0 to Count-1 do begin
|
||||
Item:=Items[i];
|
||||
if Item.Name='' then continue;
|
||||
inc(Cnt);
|
||||
SubPath:='Item'+IntToStr(Cnt)+'/';
|
||||
Cfg.SetDeleteValue(SubPath+'Name',Item.Name,'');
|
||||
cfg.SetDeleteValue(SubPath+'IDs',Item.IDs,'');
|
||||
cfg.SetDeleteValue(SubPath+'RegEx',Item.RegEx,'');
|
||||
cfg.SetDeleteValue(SubPath+'URL',Item.URL,'');
|
||||
end;
|
||||
Cfg.SetDeleteValue('Count',Cnt,0);
|
||||
finally
|
||||
Cfg.UndoAppendBasePath;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMessageHelpAdditions.LoadFromFile(Filename: string);
|
||||
var
|
||||
Cfg: TConfigStorage;
|
||||
begin
|
||||
try
|
||||
Cfg:=GetIDEConfigStorage(Filename,true);
|
||||
try
|
||||
LoadFromConfig(Cfg);
|
||||
finally
|
||||
Cfg.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do begin
|
||||
debugln(['TMessageHelpAdditions.LoadFromFile unable to load file "'+Filename+'": '+E.Message]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMessageHelpAdditions.SaveToFile(Filename: string);
|
||||
var
|
||||
Cfg: TConfigStorage;
|
||||
begin
|
||||
try
|
||||
Cfg:=GetIDEConfigStorage(Filename,false);
|
||||
try
|
||||
SaveToConfig(Cfg);
|
||||
Cfg.WriteToDisk;
|
||||
finally
|
||||
Cfg.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do begin
|
||||
debugln(['TMessageHelpAdditions.SaveToFile unable to save file "'+Filename+'": '+E.Message]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TMessageHelpAddition }
|
||||
|
||||
procedure TMessageHelpAddition.Assign(Source: TMessageHelpAddition);
|
||||
begin
|
||||
Name:=Source.Name;
|
||||
IDs:=Source.IDs;
|
||||
RegEx:=Source.RegEx;
|
||||
URL:=Source.URL;
|
||||
end;
|
||||
|
||||
function TMessageHelpAddition.IsEqual(Source: TMessageHelpAddition): boolean;
|
||||
begin
|
||||
Result:=(Name=Source.Name)
|
||||
and (IDs=Source.IDs)
|
||||
and (RegEx=Source.RegEx)
|
||||
and (URL=Source.URL);
|
||||
end;
|
||||
|
||||
function TMessageHelpAddition.Fits(ID: integer; Msg: string): boolean;
|
||||
var
|
||||
CurID: Integer;
|
||||
p: PChar;
|
||||
begin
|
||||
Result:=false;
|
||||
if Msg='' then exit;
|
||||
if RegEx<>'' then begin
|
||||
try
|
||||
Result:=REMatches(Msg,RegEx,'I');
|
||||
except
|
||||
end;
|
||||
if not Result then exit;
|
||||
end;
|
||||
if IDs<>'' then begin
|
||||
Result:=false;
|
||||
p:=PChar(IDs);
|
||||
CurID:=0;
|
||||
while p^<>#0 do begin
|
||||
case p^ of
|
||||
',':
|
||||
if (CurID>0) and (CurID=ID) then begin
|
||||
Result:=true;
|
||||
break;
|
||||
end;
|
||||
'0'..'9':
|
||||
begin
|
||||
CurID:=CurID*10+ord(p^)-ord('0');
|
||||
if CurID>100000 then exit;
|
||||
end;
|
||||
else exit;
|
||||
end;
|
||||
inc(p);
|
||||
end;
|
||||
if (CurID>0) and (CurID=ID) then Result:=true;
|
||||
if not Result then exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TEditIDEMsgHelpDialog }
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.FormCreate(Sender: TObject);
|
||||
begin
|
||||
fDefaultValue:='(default)';
|
||||
Caption:='Edit additional help for FPC messages';
|
||||
|
||||
GlobalOptionsGroupBox.Caption:='Global settings';
|
||||
FPCMsgFileLabel.Caption:='FPC message file:';
|
||||
AdditionsFileLabel.Caption:='Config file of additions:';
|
||||
|
||||
CurMsgGroupBox.Caption:='Selected message in messages window:';
|
||||
|
||||
AllGroupBox.Caption:='All additional';
|
||||
AddButton.Caption:='Create new item';
|
||||
AllGroupBox.Caption:='Additions';
|
||||
AddButton.Caption:='Create new addition';
|
||||
|
||||
NameLabel.Caption:='Name:';
|
||||
OnlyFPCMsgIDsLabel.Caption:='Only messages with these FPC IDs (comma separated):';
|
||||
OnlyRegExLabel.Caption:='Only messages fitting this regular expression:';
|
||||
URLLabel.Caption:='URL on wiki, the base url is '
|
||||
+(FPCMessagesHelpDB as THTMLHelpDatabase).GetEffectiveBaseURL;
|
||||
URLLabel.Caption:='URL on wiki (the base url is '
|
||||
+(FPCMessagesHelpDB as THTMLHelpDatabase).GetEffectiveBaseURL+')';
|
||||
TestURLButton.Caption:='Test URL';
|
||||
|
||||
DeleteButton.Caption:='Delete this item';
|
||||
DeleteButton.Caption:='Delete this addition';
|
||||
|
||||
ButtonPanel1.OKButton.OnClick:=@ButtonPanel1OKButtonClick;
|
||||
|
||||
// global options
|
||||
FPCMsgFileEdit.Text:=FPCMsgHelpDB.FPCTranslationFile;
|
||||
AdditionsFileEdit.Text:=FPCMsgHelpDB.AdditionsFile;
|
||||
|
||||
// fetch selected message
|
||||
UpdateCurMessage;
|
||||
|
||||
// list of additions
|
||||
FPCMsgHelpDB.LoadAdditions;
|
||||
Additions:=TMessageHelpAdditions.Create;
|
||||
Additions.Clone(FPCMsgHelpDB.fAdditions);
|
||||
FillAdditionsList;
|
||||
|
||||
// current addition
|
||||
if AllListBox.Items.Count>0 then
|
||||
AllListBox.ItemIndex:=0;
|
||||
UpdateCurAddition;
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.ButtonPanel1Click(Sender: TObject);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.AllListBoxSelectionChange(Sender: TObject;
|
||||
User: boolean);
|
||||
begin
|
||||
UpdateCurAddition;
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.AddButtonClick(Sender: TObject);
|
||||
var
|
||||
i: Integer;
|
||||
Prefix: String;
|
||||
NewName: String;
|
||||
Item: TMessageHelpAddition;
|
||||
begin
|
||||
if CurFPCId>=0 then
|
||||
Prefix:='Msg'+IntToStr(CurFPCId)+'_'
|
||||
else
|
||||
Prefix:='Msg';
|
||||
i:=1;
|
||||
repeat
|
||||
NewName:=Prefix+IntToStr(i);
|
||||
if Additions.FindWithName(NewName)=nil then break;
|
||||
inc(i);
|
||||
until false;
|
||||
Item:=TMessageHelpAddition.Create;
|
||||
Item.Name:=NewName;
|
||||
if CurFPCId>=0 then
|
||||
Item.IDs:=IntToStr(CurFPCId);
|
||||
Additions.Add(Item);
|
||||
FillAdditionsList;
|
||||
AllListBox.ItemIndex:=AllListBox.Items.IndexOf(Item.Name);
|
||||
UpdateCurAddition;
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.ButtonPanel1OKButtonClick(Sender: TObject);
|
||||
var
|
||||
Filename: TCaption;
|
||||
HasChanged: Boolean;
|
||||
begin
|
||||
HasChanged:=false;
|
||||
|
||||
Filename:=FPCMsgFileEdit.Text;
|
||||
if (Filename=fDefaultValue) then
|
||||
Filename:='';
|
||||
if FPCMsgHelpDB.FPCTranslationFile<>Filename then begin
|
||||
FPCMsgHelpDB.FPCTranslationFile:=Filename;
|
||||
HasChanged:=true;
|
||||
end;
|
||||
|
||||
Filename:=AdditionsFileEdit.Text;
|
||||
if (Filename=fDefaultValue)
|
||||
or (Filename=FPCMsgHelpDB.FDefaultAdditionsFile) then
|
||||
Filename:='';
|
||||
if FPCMsgHelpDB.AdditionsFile<>Filename then begin
|
||||
FPCMsgHelpDB.AdditionsFile:=Filename;
|
||||
HasChanged:=true;
|
||||
end;
|
||||
|
||||
if HasChanged then begin
|
||||
// ToDo: save changes
|
||||
ShowMessage('Saving global options is not yet supported');
|
||||
end;
|
||||
|
||||
if not Additions.IsEqual(FPCMsgHelpDB.fAdditions) then
|
||||
begin
|
||||
FPCMsgHelpDB.fAdditions.Clone(Additions);
|
||||
FPCMsgHelpDB.SaveAdditions;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.DeleteButtonClick(Sender: TObject);
|
||||
var
|
||||
i: LongInt;
|
||||
NewIndex: Integer;
|
||||
begin
|
||||
if CurAddition=nil then exit;
|
||||
if IDEMessageDialog('Delete?',
|
||||
'Delete addition "'+CurAddition.Name+'"?',mtConfirmation,[mbYes,mbNo])<>mrYes
|
||||
then exit;
|
||||
NewIndex:=AllListBox.ItemIndex;
|
||||
i:=Additions.IndexOf(CurAddition);
|
||||
CurAddition:=nil;
|
||||
if i>=0 then
|
||||
Additions.Delete(i);
|
||||
FillAdditionsList;
|
||||
if NewIndex<0 then NewIndex:=0;
|
||||
if NewIndex>=AllListBox.Items.Count then dec(NewIndex);
|
||||
AllListBox.ItemIndex:=NewIndex;
|
||||
UpdateCurAddition;
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FreeAndNil(Additions);
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.FPCMsgFileEditEditingDone(Sender: TObject);
|
||||
var
|
||||
Filename: TCaption;
|
||||
begin
|
||||
Filename:=FPCMsgFileEdit.Text;
|
||||
if (Filename=fDefaultValue) then Filename:='';
|
||||
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.NameEditChange(Sender: TObject);
|
||||
var
|
||||
NewName: TCaption;
|
||||
ConflictAddition: TMessageHelpAddition;
|
||||
begin
|
||||
NewName:=NameEdit.Text;
|
||||
ConflictAddition:=Additions.FindWithName(NewName);
|
||||
if (NewName='') or (CurAddition=nil)
|
||||
or ((ConflictAddition<>nil) and (Additions.FindWithName(NewName)<>CurAddition))
|
||||
then begin
|
||||
// invalid name
|
||||
NameLabel.Font.Color:=clRed;
|
||||
end else begin
|
||||
NameLabel.Font.Color:=clDefault;
|
||||
CurAddition.Name:=NewName;
|
||||
AllListBox.Items[AllListBox.ItemIndex]:=NewName;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.OnlyFPCMsgIDsEditChange(Sender: TObject);
|
||||
var
|
||||
NewIDs: TCaption;
|
||||
begin
|
||||
NewIDs:=OnlyFPCMsgIDsEdit.Text;
|
||||
if (CurAddition=nil) or (not IsIDListValid(NewIDs)) then begin
|
||||
OnlyFPCMsgIDsLabel.Font.Color:=clRed;
|
||||
end else begin
|
||||
OnlyFPCMsgIDsLabel.Font.Color:=clDefault;
|
||||
CurAddition.IDs:=NewIDs;
|
||||
UpdateAdditionsFitsMsg;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.OnlyRegExEditChange(Sender: TObject);
|
||||
var
|
||||
NewRE: TCaption;
|
||||
begin
|
||||
NewRE:=OnlyRegExEdit.Text;
|
||||
if (CurAddition=nil) or (not IsRegexValid(NewRE)) then begin
|
||||
OnlyRegExLabel.Font.Color:=clRed;
|
||||
end else begin
|
||||
OnlyRegExLabel.Font.Color:=clDefault;
|
||||
CurAddition.RegEx:=NewRE;
|
||||
UpdateAdditionsFitsMsg;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.TestURLButtonClick(Sender: TObject);
|
||||
var
|
||||
URL: String;
|
||||
begin
|
||||
if (CurAddition=nil) or (CurAddition.URL='') then exit;
|
||||
URL:=FPCMsgHelpDB.GetEffectiveBaseURL+CurAddition.URL;
|
||||
OpenURL(URL);
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.URLEditChange(Sender: TObject);
|
||||
var
|
||||
NewURL: TCaption;
|
||||
begin
|
||||
NewURL:=URLEdit.Text;
|
||||
if (CurAddition=nil) or (not IsURLValid(NewURL)) then begin
|
||||
URLLabel.Font.Color:=clRed;
|
||||
end else begin
|
||||
URLLabel.Font.Color:=clDefault;
|
||||
CurAddition.URL:=NewURL;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.FillAdditionsList;
|
||||
var
|
||||
sl: TStringList;
|
||||
i: Integer;
|
||||
begin
|
||||
sl:=TStringList.Create;
|
||||
try
|
||||
for i:=0 to Additions.Count-1 do
|
||||
sl.Add(Additions[i].Name);
|
||||
sl.Sort;
|
||||
AllListBox.Items.Assign(sl);
|
||||
finally
|
||||
sl.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.UpdateCurAddition;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
i:=AllListBox.ItemIndex;
|
||||
if i>=0 then
|
||||
CurAddition:=Additions.FindWithName(AllListBox.Items[i])
|
||||
else
|
||||
CurAddition:=nil;
|
||||
if CurAddition=nil then begin
|
||||
CurGroupBox.Caption:='(None selected)';
|
||||
CurGroupBox.Enabled:=false;
|
||||
NameEdit.Text:='';
|
||||
OnlyFPCMsgIDsEdit.Text:='';
|
||||
OnlyRegExEdit.Text:='';
|
||||
URLEdit.Text:='';
|
||||
for i:=0 to CurGroupBox.ControlCount-1 do
|
||||
CurGroupBox.Controls[i].Enabled:=false;
|
||||
NameLabel.Font.Color:=clDefault;
|
||||
OnlyFPCMsgIDsEdit.Font.Color:=clDefault;
|
||||
OnlyRegExEdit.Font.Color:=clDefault;
|
||||
URLEdit.Font.Color:=clDefault;
|
||||
end else begin
|
||||
CurGroupBox.Caption:='Selected addition:';
|
||||
CurGroupBox.Enabled:=true;
|
||||
NameEdit.Text:=CurAddition.Name;
|
||||
NameLabel.Font.Color:=clDefault;
|
||||
OnlyFPCMsgIDsEdit.Text:=CurAddition.IDs;
|
||||
if not IsIDListValid(CurAddition.IDs) then
|
||||
OnlyFPCMsgIDsLabel.Font.Color:=clRed
|
||||
else
|
||||
OnlyFPCMsgIDsLabel.Font.Color:=clDefault;
|
||||
OnlyRegExEdit.Text:=CurAddition.RegEx;
|
||||
if not IsRegexValid(CurAddition.RegEx) then
|
||||
OnlyRegExLabel.Font.Color:=clRed
|
||||
else
|
||||
OnlyRegExLabel.Font.Color:=clDefault;
|
||||
URLEdit.Text:=CurAddition.URL;
|
||||
if not IsURLValid(CurAddition.URL) then
|
||||
URLLabel.Font.Color:=clRed
|
||||
else
|
||||
URLLabel.Font.Color:=clDefault;
|
||||
for i:=0 to CurGroupBox.ControlCount-1 do
|
||||
CurGroupBox.Controls[i].Enabled:=true;
|
||||
end;
|
||||
UpdateAdditionsFitsMsg;
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.UpdateCurMessage;
|
||||
var
|
||||
Line: TIDEMessageLine;
|
||||
sl: TStringList;
|
||||
MsgFile: TFPCMsgFile;
|
||||
FPCMsg: TFPCMsgItem;
|
||||
begin
|
||||
CurMsg:='';
|
||||
CurFPCId:=-1;
|
||||
Line:=IDEMessagesWindow.GetSelectedLine;
|
||||
if Line=nil then begin
|
||||
CurMsgMemo.Text:='(no message selected)';
|
||||
CurMsgMemo.Enabled:=false;
|
||||
end else begin
|
||||
CurMsg:=Line.Msg;
|
||||
sl:=TStringList.Create;
|
||||
try
|
||||
sl.Add('Msg='+Line.Msg);
|
||||
MsgFile:=FPCMsgHelpDB.GetMsgFile;
|
||||
if MsgFile<>nil then begin
|
||||
FPCMsg:=MsgFile.FindWithMessage(Line.Msg);
|
||||
if FPCMsg<>nil then begin
|
||||
CurFPCId:=FPCMsg.ID;
|
||||
sl.Add('FPC Msg='+FPCMsg.GetName);
|
||||
end;
|
||||
end;
|
||||
sl.Add('Directory='+Line.Directory);
|
||||
if Line.Parts<>nil then
|
||||
sl.AddStrings(Line.Parts);
|
||||
CurMsgMemo.Text:=sl.Text;
|
||||
finally
|
||||
sl.Free;
|
||||
end;
|
||||
CurMsgMemo.Enabled:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TEditIDEMsgHelpDialog.UpdateAdditionsFitsMsg;
|
||||
begin
|
||||
if (CurAddition=nil) or (CurMsg='') then
|
||||
AdditionFitsMsgLabel.Visible:=false
|
||||
else begin
|
||||
AdditionFitsMsgLabel.Visible:=true;
|
||||
if CurAddition.Fits(CurFPCId,CurMsg) then begin
|
||||
AdditionFitsMsgLabel.Caption:='Addition fits the current message';
|
||||
end else begin
|
||||
AdditionFitsMsgLabel.Caption:='Addition does not fit the current message';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TEditIDEMsgHelpDialog.IsIDListValid(IDs: string): boolean;
|
||||
// comma separated decimal numbers
|
||||
var
|
||||
p: PChar;
|
||||
id: Integer;
|
||||
begin
|
||||
if IDs='' then exit(true);
|
||||
Result:=false;
|
||||
p:=PChar(IDs);
|
||||
id:=0;
|
||||
while p^<>#0 do begin
|
||||
case p^ of
|
||||
',': id:=0;
|
||||
'0'..'9':
|
||||
begin
|
||||
id:=id*10+ord(p^)-ord('0');
|
||||
if id>100000 then begin
|
||||
debugln(['TEditIDEMsgHelpDialog.IsIDListValid id too big ',id]);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
debugln(['TEditIDEMsgHelpDialog.IsIDListValid invalid character ',ord(p^),'=',dbgstr(p[0])]);
|
||||
exit;
|
||||
end;
|
||||
inc(p);
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TEditIDEMsgHelpDialog.IsRegexValid(re: string): boolean;
|
||||
begin
|
||||
if re='' then exit(true);
|
||||
Result:=false;
|
||||
try
|
||||
REMatches('',re,'I');
|
||||
Result:=true;
|
||||
except
|
||||
on E: Exception do begin
|
||||
debugln(['TEditIDEMsgHelpDialog.IsRegexValid inalid Re="',re,'": ',E.Message]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TEditIDEMsgHelpDialog.IsURLValid(URL: string): boolean;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result:=false;
|
||||
if URL='' then exit;
|
||||
for i:=1 to length(URL) do begin
|
||||
if URL[i] in [#0..#32] then exit;
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
{ TFPCMessagesHelpDatabase }
|
||||
@ -237,6 +859,7 @@ begin
|
||||
if FAdditionsFile=AValue then Exit;
|
||||
FAdditionsFile:=AValue;
|
||||
FAdditionsChangeStep:=CTInvalidChangeStamp;
|
||||
FLoadedAdditionsFilename:='';
|
||||
end;
|
||||
|
||||
procedure TFPCMessagesHelpDatabase.SetLastMessage(const AValue: string);
|
||||
@ -251,7 +874,6 @@ begin
|
||||
FDefaultAdditionsFile:='$(LazarusDir)/docs/additionalmsghelp.xml';
|
||||
fAdditions:=TMessageHelpAdditions.Create;
|
||||
FAdditionsChangeStep:=CTInvalidChangeStamp;
|
||||
FAdditionsFile:=DefaultAdditionsFile;
|
||||
FMsgFileChangeStep:=CTInvalidChangeStamp;
|
||||
FDefaultNode:=THelpNode.CreateURL(Self,'FPC messages: Appendix',
|
||||
'http://lazarus-ccr.sourceforge.net/fpcdoc/user/userap3.html#x81-168000C');
|
||||
@ -270,17 +892,36 @@ function TFPCMessagesHelpDatabase.GetNodesForMessage(const AMessage: string;
|
||||
var ErrMsg: string): TShowHelpResult;
|
||||
var
|
||||
MsgItem: TFPCMsgItem;
|
||||
i: Integer;
|
||||
FPCID: Integer;
|
||||
begin
|
||||
FFoundAddition:=nil;
|
||||
FFoundComment:='';
|
||||
Result:=inherited GetNodesForMessage(AMessage, MessageParts, ListOfNodes,
|
||||
ErrMsg);
|
||||
if (ListOfNodes<>nil) and (ListOfNodes.Count>0) then exit;
|
||||
LastMessage:=AMessage;
|
||||
|
||||
// search message in FPC message file
|
||||
GetMsgFile;
|
||||
MsgItem:=MsgFile.FindWithMessage(AMessage);
|
||||
if MsgItem=nil then exit;
|
||||
FoundComment:=MsgItem.GetTrimmedComment(true,true);
|
||||
if FoundComment<>'' then begin
|
||||
FPCID:=-1;
|
||||
if MsgItem<>nil then
|
||||
FPCID:=MsgItem.ID;
|
||||
|
||||
// search message in additions
|
||||
LoadAdditions;
|
||||
FFoundAddition:=nil;
|
||||
for i:=0 to AdditionsCount-1 do begin
|
||||
if Additions[i].Fits(FPCID,AMessage) then begin
|
||||
FFoundAddition:=Additions[i];
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (FoundComment<>'') or (FoundAddition<>nil) then begin
|
||||
Result:=shrSuccess;
|
||||
CreateNodeQueryListAndAdd(DefaultNode,nil,ListOfNodes,true);
|
||||
//DebugLn('TFPCMessagesHelpDatabase.GetNodesForMessage ',FoundComment);
|
||||
@ -290,17 +931,35 @@ end;
|
||||
function TFPCMessagesHelpDatabase.ShowHelp(Query: THelpQuery; BaseNode,
|
||||
NewNode: THelpNode; QueryItem: THelpQueryItem; var ErrMsg: string
|
||||
): TShowHelpResult;
|
||||
var
|
||||
URL: String;
|
||||
begin
|
||||
if NewNode=DefaultNode then begin
|
||||
if FoundComment<>'' then begin
|
||||
Result:=shrSuccess;
|
||||
MessageDlg(lisHFMHelpForFreePascalCompilerMessage, FoundComment,
|
||||
mtInformation,[mbOk],0);
|
||||
end else begin
|
||||
Result:=shrHelpNotFound;
|
||||
end;
|
||||
end else begin
|
||||
Result:=shrHelpNotFound;
|
||||
if NewNode<>DefaultNode then begin
|
||||
Result:=inherited ShowHelp(Query, BaseNode, NewNode, QueryItem, ErrMsg);
|
||||
end else begin
|
||||
URL:='';
|
||||
if (FoundAddition<>nil) and (FoundAddition.URL<>'') then
|
||||
URL:=GetEffectiveBaseURL+FoundAddition.URL;
|
||||
if FoundComment<>'' then begin
|
||||
if URL='' then begin
|
||||
IDEMessageDialog(lisHFMHelpForFreePascalCompilerMessage, FoundComment,
|
||||
mtInformation,[mbOk]);
|
||||
end else begin
|
||||
if IDEQuestionDialog(lisHFMHelpForFreePascalCompilerMessage, FoundComment
|
||||
+#13#13'There are additional notes for this message on'#13
|
||||
+URL,
|
||||
mtInformation,[mrYes,'Open URL',mrClose])
|
||||
=mrYes then begin
|
||||
if not OpenURL(URL) then
|
||||
exit(shrViewerError);
|
||||
end;
|
||||
end;
|
||||
end else if URL<>'' then begin
|
||||
if not OpenURL(URL) then
|
||||
exit(shrViewerError);
|
||||
end;
|
||||
Result:=shrSuccess;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -308,14 +967,14 @@ procedure TFPCMessagesHelpDatabase.Load(Storage: TConfigStorage);
|
||||
begin
|
||||
inherited Load(Storage);
|
||||
FPCTranslationFile:=Storage.GetValue('FPCTranslationFile/Value','');
|
||||
AdditionsFile:=Storage.GetValue('Additions/Filename',DefaultAdditionsFile);
|
||||
AdditionsFile:=Storage.GetValue('Additions/Filename','');
|
||||
end;
|
||||
|
||||
procedure TFPCMessagesHelpDatabase.Save(Storage: TConfigStorage);
|
||||
begin
|
||||
inherited Save(Storage);
|
||||
Storage.SetDeleteValue('FPCTranslationFile/Value',FPCTranslationFile,'');
|
||||
Storage.SetDeleteValue('Additions/Filename',AdditionsFile,DefaultAdditionsFile);
|
||||
Storage.SetDeleteValue('Additions/Filename',AdditionsFile,'');
|
||||
end;
|
||||
|
||||
function TFPCMessagesHelpDatabase.GetMsgFile: TFPCMsgFile;
|
||||
@ -364,5 +1023,63 @@ begin
|
||||
Result:=fAdditions.Count;
|
||||
end;
|
||||
|
||||
procedure TFPCMessagesHelpDatabase.ClearAdditions;
|
||||
begin
|
||||
fAdditions.Clear;
|
||||
FLoadedAdditionsFilename:='';
|
||||
FAdditionsChangeStep:=CTInvalidChangeStamp;
|
||||
FFoundAddition:=nil;
|
||||
end;
|
||||
|
||||
procedure TFPCMessagesHelpDatabase.LoadAdditions;
|
||||
var
|
||||
Filename: String;
|
||||
Code: TCodeBuffer;
|
||||
begin
|
||||
Filename:=GetAdditionsFilename;
|
||||
if FLoadedAdditionsFilename<>Filename then
|
||||
FAdditionsChangeStep:=CTInvalidChangeStamp;
|
||||
Code:=CodeToolBoss.LoadFile(Filename,true,false);
|
||||
if Code<>nil then begin
|
||||
if Code.ChangeStep=AdditionsChangeStep then exit;
|
||||
fAdditionsChangeStep:=Code.ChangeStep;
|
||||
end else
|
||||
fAdditionsChangeStep:=CTInvalidChangeStamp;
|
||||
ClearAdditions;
|
||||
fAdditions.LoadFromFile(Filename);
|
||||
FLoadedAdditionsFilename:=Filename;
|
||||
end;
|
||||
|
||||
procedure TFPCMessagesHelpDatabase.SaveAdditions;
|
||||
var
|
||||
Code: TCodeBuffer;
|
||||
Filename: String;
|
||||
begin
|
||||
Filename:=GetAdditionsFilename;
|
||||
fAdditions.SaveToFile(Filename);
|
||||
Code:=CodeToolBoss.LoadFile(Filename,true,false);
|
||||
if Code<>nil then
|
||||
fAdditionsChangeStep:=Code.ChangeStep;
|
||||
FLoadedAdditionsFilename:=Filename;
|
||||
end;
|
||||
|
||||
function TFPCMessagesHelpDatabase.GetAdditionsFilename: string;
|
||||
var
|
||||
LazDir: String;
|
||||
begin
|
||||
Result:=AdditionsFile;
|
||||
IDEMacros.SubstituteMacros(Result);
|
||||
if Result='' then begin
|
||||
Result:=FDefaultAdditionsFile;
|
||||
IDEMacros.SubstituteMacros(Result);
|
||||
end;
|
||||
Result:=TrimFilename(Result);
|
||||
if not FilenameIsAbsolute(Result) then begin
|
||||
LazDir:='$(LazarusDir)';
|
||||
IDEMacros.SubstituteMacros(LazDir);
|
||||
Result:=TrimFilename(AppendPathDelim(LazDir)+Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -63,7 +63,7 @@
|
||||
<PackageName Value="SynEdit"/>
|
||||
</Item6>
|
||||
</RequiredPackages>
|
||||
<Units Count="88">
|
||||
<Units Count="89">
|
||||
<Unit0>
|
||||
<Filename Value="lazarus.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
@ -662,6 +662,12 @@
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="NewPkgComponentDlg"/>
|
||||
</Unit87>
|
||||
<Unit88>
|
||||
<Filename Value="msgview.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<HasResources Value="True"/>
|
||||
<UnitName Value="MsgView"/>
|
||||
</Unit88>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
||||
@ -47,7 +47,7 @@ uses
|
||||
SrcEditorIntf, LazIDEIntf,
|
||||
DialogProcs, EnvironmentOpts, SourceMarks,
|
||||
LazarusIDEStrConsts, IDEOptionDefs, IDEProcs, InputHistory, infobuild,
|
||||
KeyMapping;
|
||||
KeyMapping, HelpFPCMessages;
|
||||
|
||||
type
|
||||
|
||||
@ -174,10 +174,11 @@ type
|
||||
procedure SaveMessagesToFile(const Filename: string);
|
||||
procedure SrcEditLinesInsertedDeleted(const Filename: string;
|
||||
FirstLine, LineCount: Integer);
|
||||
procedure UpdateMsgLineInListBox(Line: TLazMessageLine);
|
||||
procedure UpdateMsgLineInView(Line: TLazMessageLine);
|
||||
function ExecuteMsgLinePlugin(Step: TIMQuickFixStep): boolean;
|
||||
procedure HideLine(Line: TLazMessageLine);
|
||||
procedure ConsistencyCheck;
|
||||
function GetSelectedLine: TIDEMessageLine; override;
|
||||
public
|
||||
property LastLineIsProgress: boolean read FLastLineIsProgress
|
||||
write SetLastLineIsProgress;
|
||||
@ -541,7 +542,7 @@ procedure TMessagesView.CollectLineParts(Sender: TObject;
|
||||
HideLine(ALine);
|
||||
end;
|
||||
if (OldMsg<>ALine.Msg) then begin
|
||||
UpdateMsgLineInListBox(ALine);
|
||||
UpdateMsgLineInView(ALine);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -746,14 +747,14 @@ begin
|
||||
Line.Parts.Values['Line']:=IntToStr(Line.LineNumber);
|
||||
Line.SetSourcePosition('',Line.LineNumber,0);
|
||||
//DebugLn('TMessagesView.SrcEditLinesInsertedDeleted ',Line.Msg,' ',dbgs(Line.VisiblePosition));
|
||||
UpdateMsgLineInListBox(Line);
|
||||
UpdateMsgLineInView(Line);
|
||||
end;
|
||||
|
||||
ANode:=FSrcPositions.FindSuccessor(ANode);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMessagesView.UpdateMsgLineInListBox(Line: TLazMessageLine);
|
||||
procedure TMessagesView.UpdateMsgLineInView(Line: TLazMessageLine);
|
||||
begin
|
||||
if (Line.VisiblePosition>=0)
|
||||
and (Line.VisiblePosition<MessageTreeView.Items.Count) then begin
|
||||
@ -782,7 +783,7 @@ begin
|
||||
DeleteLine(Msg.Position);
|
||||
end else begin
|
||||
UpdateMsgSrcPos(Msg);
|
||||
UpdateMsgLineInListBox(Msg);
|
||||
UpdateMsgLineInView(Msg);
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
@ -944,7 +945,7 @@ end;
|
||||
|
||||
procedure TMessagesView.EditHelpMenuItemClick(Sender: TObject);
|
||||
begin
|
||||
// ShowMessageHelpEditor;
|
||||
ShowMessageHelpEditor;
|
||||
end;
|
||||
|
||||
procedure TMessagesView.FormDeactivate(Sender: TObject);
|
||||
@ -1114,7 +1115,7 @@ begin
|
||||
DeleteLine(Msg.Position);
|
||||
end else begin
|
||||
UpdateMsgSrcPos(Msg);
|
||||
UpdateMsgLineInListBox(Msg);
|
||||
UpdateMsgLineInView(Msg);
|
||||
end;
|
||||
exit;
|
||||
//ConsistencyCheck;
|
||||
@ -1297,6 +1298,11 @@ begin
|
||||
RaiseGDBException('TMessagesView.ConsistencyCheck FLastLineIsProgress and FVisibleItems.Count=0');
|
||||
end;
|
||||
|
||||
function TMessagesView.GetSelectedLine: TIDEMessageLine;
|
||||
begin
|
||||
Result:=GetMessageLine;
|
||||
end;
|
||||
|
||||
function TMessagesView.FindNextItem(const Filename: string; FirstLine,
|
||||
LineCount: integer): TAVLTreeNode;
|
||||
var
|
||||
|
||||
@ -244,6 +244,7 @@ type
|
||||
function LinesCount: integer; virtual; abstract;
|
||||
procedure BeginBlock(ClearOldBlocks: Boolean = true); virtual; abstract;
|
||||
procedure EndBlock; virtual; abstract;
|
||||
function GetSelectedLine: TIDEMessageLine; virtual; abstract;
|
||||
end;
|
||||
|
||||
var
|
||||
|
||||
Loading…
Reference in New Issue
Block a user