paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-05 16:59:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

improved IDE Help selector for items in same node, added more compiler targets

Browse Source 
git-svn-id: trunk@7994 -
This commit is contained in:
mattias 2005-10-29 09:01:06 +00:00
parent c8884125e2
commit ad36183ec0
6 changed files with 441 additions and 188 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

188
ide/compileroptionsdlg.pp
View File

@ -114,7 +114,14 @@ type
radGenFaster: TRadioButton; radGenFaster: TRadioButton;
radGenSmaller: TRadioButton; radGenSmaller: TRadioButton;
grpTargetProc: TRadioGroup; grpTargetPlatform: TGroupBox;
lblTargetOS : TLabel;
TargetOSComboBox: TComboBox;
lblTargetCPU : TLabel;
TargetCPUComboBox: TComboBox;
lblTargeti386Proc : TLabel;
Targeti386ProcComboBox: TComboBox;
TargetOSGroupBox: TGroupBox;
grpOptimizations: TGroupBox; grpOptimizations: TGroupBox;
chkOptVarsInReg: TCheckBox; chkOptVarsInReg: TCheckBox;
@ -124,8 +131,6 @@ type
radOptLevel2: TRadioButton; radOptLevel2: TRadioButton;
radOptLevel3: TRadioButton; radOptLevel3: TRadioButton;
TargetOSGroupBox: TGroupBox;
TargetOSComboBox: TComboBox;
{ Linking Controls } { Linking Controls }
LinkingPage: TPage; LinkingPage: TPage;
@ -640,10 +645,6 @@ begin
i:=LCLWidgetTypeRadioGroup.Items.IndexOf(Options.LCLWidgetType); i:=LCLWidgetTypeRadioGroup.Items.IndexOf(Options.LCLWidgetType);
if i<0 then i:=0; if i<0 then i:=0;
LCLWidgetTypeRadioGroup.ItemIndex:=i; LCLWidgetTypeRadioGroup.ItemIndex:=i;
i:=TargetOSComboBox.Items.IndexOf(Options.TargetOS);
if i<0 then i:=0; // 0 is default
TargetOSComboBox.ItemIndex:=i;
TargetOSComboBox.Text:=Options.TargetOS;
// parsing // parsing
if (Options.AssemblerStyle in [1,2,3]) then if (Options.AssemblerStyle in [1,2,3]) then
@ -681,10 +682,19 @@ begin
cgcSmallerCode: radGenSmaller.Checked := true; cgcSmallerCode: radGenSmaller.Checked := true;
end; end;
i:=TargetOSComboBox.Items.IndexOf(Options.TargetOS);
if i<0 then i:=0; // 0 is default
TargetOSComboBox.ItemIndex:=i;
TargetOSComboBox.Text:=Options.TargetOS;
i:=TargetCPUComboBox.Items.IndexOf(Options.TargetCPU);
if i<0 then i:=0; // 0 is default
TargetCPUComboBox.ItemIndex:=i;
TargetCPUComboBox.Text:=Options.TargetCPU;
case Options.TargetProcessor of case Options.TargetProcessor of
1..3: grpTargetProc.ItemIndex:=Options.TargetProcessor; 1..3: Targeti386ProcComboBox.ItemIndex:=Options.TargetProcessor;
else else
grpTargetProc.ItemIndex:=0; Targeti386ProcComboBox.ItemIndex := 0;
end; end;
chkOptVarsInReg.Checked := Options.VariablesInRegisters; chkOptVarsInReg.Checked := Options.VariablesInRegisters;
@ -845,7 +855,8 @@ var
hs: LongInt; hs: LongInt;
i: integer; i: integer;
OldCompOpts: TBaseCompilerOptions; OldCompOpts: TBaseCompilerOptions;
NewTargetOS: String; NewTargetOS,
NewTargetCPU: String;
Options: TBaseCompilerOptions; Options: TBaseCompilerOptions;
NewDontUseConfigFile: Boolean; NewDontUseConfigFile: Boolean;
NewCustomConfigFile: Boolean; NewCustomConfigFile: Boolean;
@ -943,8 +954,17 @@ begin
else else
Options.Generate := cgcNormalCode; Options.Generate := cgcNormalCode;
Options.TargetProcessor := grpTargetProc.ItemIndex; NewTargetOS:=TargetOSComboBox.Text;
if TargetOSComboBox.Items.IndexOf(NewTargetOS)<=0 then
NewTargetOS:='';
Options.TargetOS:=NewTargetOS;
NewTargetCPU:=TargetCPUComboBox.Text;
if TargetCPUComboBox.Items.IndexOf(NewTargetCPU)<=0 then
NewTargetCPU:='';
Options.TargetCPU:=NewTargetCPU;
Options.TargetProcessor := Targeti386ProcComboBox.ItemIndex;
Options.VariablesInRegisters := chkOptVarsInReg.Checked; Options.VariablesInRegisters := chkOptVarsInReg.Checked;
Options.UncertainOptimizations := chkOptUncertain.Checked; Options.UncertainOptimizations := chkOptUncertain.Checked;
@ -1001,12 +1021,6 @@ begin
Options.StopAfterErrCount := StrToIntDef(edtErrorCnt.Text,1); Options.StopAfterErrCount := StrToIntDef(edtErrorCnt.Text,1);
NewTargetOS:=TargetOSComboBox.Text;
if TargetOSComboBox.Items.IndexOf(NewTargetOS)<=0 then
NewTargetOS:='';
Options.TargetOS:=NewTargetOS;
// compilation // compilation
Options.ExecuteBefore.Command := ExecuteBeforeCommandEdit.Text; Options.ExecuteBefore.Command := ExecuteBeforeCommandEdit.Text;
Options.ExecuteBefore.ScanForFPCMessages := Options.ExecuteBefore.ScanForFPCMessages :=
@ -1358,7 +1372,9 @@ end;
procedure TfrmCompilerOptions.SetupCodeGenerationTab(Page: integer); procedure TfrmCompilerOptions.SetupCodeGenerationTab(Page: integer);
var var
w: Integer; w: Integer;
yDiff: Integer;
begin begin
yDiff:=22;
// Setup the Code Generation Tab // Setup the Code Generation Tab
CodeGenPage:=nbMain.Page[Page]; CodeGenPage:=nbMain.Page[Page];
@ -1467,8 +1483,8 @@ begin
begin begin
Parent := CodeGenPage; Parent := CodeGenPage;
Top := grpSmartLinkUnit.Top + grpSmartLinkUnit.Height + 6; Top := grpSmartLinkUnit.Top + grpSmartLinkUnit.Height + 6;
Left := 10; Left := 5;
Height := 90; Height := 100;
Width := 150; Width := 150;
Caption := dlgCOGenerate; Caption := dlgCOGenerate;
end; end;
@ -1506,21 +1522,109 @@ begin
{------------------------------------------------------------} {------------------------------------------------------------}
grpTargetProc := TRadioGroup.Create(Self); grpTargetPlatform := TGroupBox.Create(Self);
with grpTargetProc do with grpTargetPlatform do
begin begin
Name := 'grpTargetPlatform';
Parent := CodeGenPage; Parent := CodeGenPage;
Top := grpGenerate.Top; Top := grpGenerate.Top;
Left := grpGenerate.Left + grpGenerate.Width + 10; Left := grpGenerate.Left + grpGenerate.Width + 10;
Height := 90; Height := 100;
Width := 300; Width := 300;
Caption := dlgTargetProc; Caption := dlgTargetPlatform;
end;
TargetOSComboBox:=TComboBox.Create(Self);
with TargetOSComboBox do begin
Name:='TargetOSComboBox';
Parent := grpTargetPlatform;
Left := 100;
Top := 0;
Width := grpTargetPlatform.ClientWidth-Left-10;
with Items do begin with Items do begin
Add('default (none)'); Add('('+rsiwpDefault+')');
Add('Darwin');
Add('FreeBSD');
Add('Linux');
Add('NetBSD');
Add('OpenBSD');
Add('Solaris');
Add('Win32');
Add('WinCE');
//Add('go32v2');
//Add('os2');
//Add('beos');
//Add('qnx');
//Add('netware');
//Add('wdosx');
//Add('emx');
//Add('watcom');
//Add('netwlibc');
//Add('amiga');
//Add('atari');
//Add('palmos');
//Add('macos');
//Add('morphos');
end;
ItemIndex:=0;
end;
lblTargetOS := TLabel.Create(Self);
with lblTargetOS do begin
Name := 'lblTargetOS';
Parent := grpTargetPlatform;
Left := 4;
AnchorVerticalCenterTo(TargetOSComboBox);
Caption :=dlgTargetOS+' (-T)';
end;
TargetCPUComboBox:=TComboBox.Create(Self);
with TargetCPUComboBox do begin
Name:='TargetCPUComboBox';
Parent := grpTargetPlatform;
AnchorToCompanion(akTop,1,TargetOSComboBox);
with Items do begin
Add('('+rsiwpDefault+')');
Add('arm');
Add('i386');
Add('m68k');
Add('powerpc');
Add('sparc');
Add('x86_64');
end;
ItemIndex:=0;
end;
lblTargetCPU := TLabel.Create(Self);
with lblTargetCPU do begin
Name := 'lblTargetCPU';
Parent := grpTargetPlatform;
Left := 4;
AnchorVerticalCenterTo(TargetCPUComboBox);
Caption :=dlgTargetCPU+' (-d)';
end;
Targeti386ProcComboBox:=TComboBox.Create(Self);
with Targeti386ProcComboBox do begin
Name:='Targeti386ProcComboBox';
Parent := grpTargetPlatform;
AnchorToCompanion(akTop,1,TargetCPUComboBox);
with Items do begin
Add('('+rsiwpDefault+')');
Add('386/486 (-Op1)'); Add('386/486 (-Op1)');
Add('Pentium/Pentium MMX (-Op2)'); Add('Pentium/Pentium MMX (-Op2)');
Add('Pentium Pro/Pentium II/C6x86/K6 (-Op3)'); Add('Pentium Pro/Pentium II/C6x86/K6 (-Op3)');
end; end;
ItemIndex:=0;
end;
lblTargeti386Proc := TLabel.Create(Self);
with lblTargeti386Proc do begin
Name := 'lblTargeti386Proc';
Parent := grpTargetPlatform;
Left := 4;
AnchorVerticalCenterTo(Targeti386ProcComboBox);
Caption := dlgTargetProc;
end; end;
{------------------------------------------------------------} {------------------------------------------------------------}
@ -1529,8 +1633,8 @@ begin
with grpOptimizations do with grpOptimizations do
begin begin
Parent := CodeGenPage; Parent := CodeGenPage;
Top := grpTargetProc.Top + grpTargetProc.Height + 6; Top := grpTargetPlatform.Top + grpTargetPlatform.Height + 6;
Left := 10; Left := 5;
Height := 150; Height := 150;
Width := 360; Width := 360;
Caption := dlgOptimiz; Caption := dlgOptimiz;
@ -1596,38 +1700,7 @@ begin
Left := 5; Left := 5;
Width := w; Width := w;
end; end;
{-----------------------------------------------------}
TargetOSGroupBox:=TGroupBox.Create(Self);
with TargetOSGroupBox do begin
Name:='TargetOSGroupBox';
Parent := CodeGenPage;
Left := grpOptimizations.Left+grpOptimizations.Width+5;
Top:=grpOptimizations.Top;
Width:=150;
Height:=45;
Caption:=dlgTargetOS+' (-T)';
end;
TargetOSComboBox:=TComboBox.Create(Self);
with TargetOSComboBox do begin
Name:='TargetOSComboBox';
Parent := TargetOSGroupBox;
Align:=alTop;
with Items do begin
Add('('+rsiwpDefault+')');
Add('Darwin');
Add('FreeBSD');
Add('Linux');
Add('NetBSD');
Add('OpenBSD');
Add('Win32');
end;
ItemIndex:=0;
end;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
TfrmCompilerOptions SetupLinkingTab TfrmCompilerOptions SetupLinkingTab
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
@ -2802,4 +2875,3 @@ begin
end; end;
end. end.

73
ide/helpmanager.pas
View File

@ -42,31 +42,14 @@ uses
OutputFilter, HelpOptions, MainIntf, LazConf; OutputFilter, HelpOptions, MainIntf, LazConf;
type type
{ TBaseHelpManager }
TBaseHelpManager = class(TComponent)
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
public
procedure ConnectMainBarEvents; virtual;
procedure LoadHelpOptions; virtual; abstract;
procedure SaveHelpOptions; virtual; abstract;
function ShowHelpForSourcePosition(const Filename: string;
const CodePos: TPoint;
var ErrMsg: string): TShowHelpResult; virtual; abstract;
procedure ShowHelpForMessage(Line: integer); virtual; abstract;
end;
{ TIDEHelpDatabases } { TIDEHelpDatabases }
TIDEHelpDatabases = class(THelpDatabases) TIDEHelpDatabases = class(THelpDatabases)
public public
function ShowHelpSelector(Query: THelpQuery; Nodes: TList; function ShowHelpSelector(Query: THelpQuery; Nodes: THelpNodeQueryList;
var ErrMsg: string; var ErrMsg: string;
var Selection: THelpNode): TShowHelpResult; override; var Selection: THelpNodeQuery
): TShowHelpResult; override;
procedure ShowError(ShowResult: TShowHelpResult; const ErrMsg: string); override; procedure ShowError(ShowResult: TShowHelpResult; const ErrMsg: string); override;
function GetBaseDirectoryForBasePathObject(BasePathObject: TObject): string; override; function GetBaseDirectoryForBasePathObject(BasePathObject: TObject): string; override;
function ShowHelpForSourcePosition(Query: THelpQuerySourcePosition; function ShowHelpForSourcePosition(Query: THelpQuerySourcePosition;
@ -138,25 +121,6 @@ var
implementation implementation
{ TBaseHelpManager }
constructor TBaseHelpManager.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
HelpBoss:=Self;
end;
destructor TBaseHelpManager.Destroy;
begin
HelpBoss:=nil;
inherited Destroy;
end;
procedure TBaseHelpManager.ConnectMainBarEvents;
begin
end;
{ THelpSelectorDialog } { THelpSelectorDialog }
type type
@ -168,12 +132,12 @@ type
procedure HelpSelectorDialogClose(Sender: TObject; procedure HelpSelectorDialogClose(Sender: TObject;
var CloseAction: TCloseAction); var CloseAction: TCloseAction);
private private
FNodes: TList; FNodes: THelpNodeQueryList;
procedure SetNodes(const AValue: TList); procedure SetNodes(const AValue: THelpNodeQueryList);
procedure FillNodesListBox; procedure FillNodesListBox;
public public
constructor Create(TheOwner: TComponent); override; constructor Create(TheOwner: TComponent); override;
property Nodes: TList read FNodes write SetNodes; property Nodes: THelpNodeQueryList read FNodes write SetNodes;
end; end;
procedure THelpSelectorDialog.HelpSelectorDialogClose(Sender: TObject; procedure THelpSelectorDialog.HelpSelectorDialogClose(Sender: TObject;
@ -182,7 +146,7 @@ begin
IDEDialogLayoutList.SaveLayout(Self); IDEDialogLayoutList.SaveLayout(Self);
end; end;
procedure THelpSelectorDialog.SetNodes(const AValue: TList); procedure THelpSelectorDialog.SetNodes(const AValue: THelpNodeQueryList);
begin begin
if FNodes=AValue then exit; if FNodes=AValue then exit;
FNodes:=AValue; FNodes:=AValue;
@ -192,14 +156,14 @@ end;
procedure THelpSelectorDialog.FillNodesListBox; procedure THelpSelectorDialog.FillNodesListBox;
var var
List: TStringList; List: TStringList;
Node: THelpNode;
i: Integer; i: Integer;
NodeQuery: THelpNodeQuery;
begin begin
List:=TStringList.Create; List:=TStringList.Create;
if (Nodes<>nil) then begin if (Nodes<>nil) then begin
for i:=0 to Nodes.Count-1 do begin for i:=0 to Nodes.Count-1 do begin
Node:=TObject(Nodes[i]) as THelpNode; NodeQuery:=Nodes[i];
List.Add(Node.Title); List.Add(NodeQuery.AsString);
end; end;
end; end;
NodesListBox.Items.Assign(List); NodesListBox.Items.Assign(List);
@ -210,7 +174,7 @@ constructor THelpSelectorDialog.Create(TheOwner: TComponent);
begin begin
inherited Create(TheOwner); inherited Create(TheOwner);
Position:=poScreenCenter; Position:=poScreenCenter;
IDEDialogLayoutList.ApplyLayout(Self,500,300); IDEDialogLayoutList.ApplyLayout(Self,500,200);
OnClose:=@HelpSelectorDialogClose; OnClose:=@HelpSelectorDialogClose;
NodesGroupBox:=TGroupBox.Create(Self); NodesGroupBox:=TGroupBox.Create(Self);
@ -220,7 +184,7 @@ begin
Left:=5; Left:=5;
Top:=5; Top:=5;
Width:=Self.ClientWidth-10; Width:=Self.ClientWidth-10;
Height:=Self.ClientWidth-40; Height:=Self.ClientHeight-50;
Anchors:=[akLeft,akTop,akRight,akBottom]; Anchors:=[akLeft,akTop,akRight,akBottom];
Caption:=lisSelectAHelpItem; Caption:=lisSelectAHelpItem;
end; end;
@ -259,8 +223,11 @@ end;
{ TIDEHelpDatabases } { TIDEHelpDatabases }
function TIDEHelpDatabases.ShowHelpSelector(Query: THelpQuery; Nodes: TList; function TIDEHelpDatabases.ShowHelpSelector(Query: THelpQuery;
var ErrMsg: string; var Selection: THelpNode): TShowHelpResult; Nodes: THelpNodeQueryList;
var ErrMsg: string;
var Selection: THelpNodeQuery
): TShowHelpResult;
var var
Dialog: THelpSelectorDialog; Dialog: THelpSelectorDialog;
i: LongInt; i: LongInt;
@ -273,7 +240,7 @@ begin
if Dialog.ShowModal=mrOk then begin if Dialog.ShowModal=mrOk then begin
i:=Dialog.NodesListBox.ItemIndex; i:=Dialog.NodesListBox.ItemIndex;
if i>=0 then begin if i>=0 then begin
Selection:=THelpNode(Nodes[i]); Selection:=Nodes[i];
Result:=shrSuccess; Result:=shrSuccess;
end; end;
end; end;
@ -321,7 +288,7 @@ function TIDEHelpDatabases.ShowHelpForSourcePosition(
Query: THelpQuerySourcePosition; var ErrMsg: string): TShowHelpResult; Query: THelpQuerySourcePosition; var ErrMsg: string): TShowHelpResult;
begin begin
Result:=HelpBoss.ShowHelpForSourcePosition(Query.Filename, Result:=HelpBoss.ShowHelpForSourcePosition(Query.Filename,
Query.SourcePosition,ErrMsg); Query.SourcePosition,ErrMsg);
end; end;
{ THelpManager } { THelpManager }
@ -455,6 +422,7 @@ end;
constructor THelpManager.Create(TheOwner: TComponent); constructor THelpManager.Create(TheOwner: TComponent);
begin begin
inherited Create(TheOwner); inherited Create(TheOwner);
HelpBoss:=Self;
HelpOpts:=THelpOptions.Create; HelpOpts:=THelpOptions.Create;
HelpOpts.SetDefaultFilename; HelpOpts.SetDefaultFilename;
HelpDatabases:=TIDEHelpDatabases.Create; HelpDatabases:=TIDEHelpDatabases.Create;
@ -476,6 +444,7 @@ begin
FreeThenNil(FRTLHelpDBPath); FreeThenNil(FRTLHelpDBPath);
FreeThenNil(FFCLHelpDBPath); FreeThenNil(FFCLHelpDBPath);
FreeThenNil(FLCLHelpDBPath); FreeThenNil(FLCLHelpDBPath);
HelpBoss:=nil;
inherited Destroy; inherited Destroy;
end; end;

5
ide/lazarusidestrconsts.pas
View File

@ -987,7 +987,8 @@ resourcestring
dlgCONormal = 'Normal Code'; dlgCONormal = 'Normal Code';
dlgCOFast = 'Faster Code'; dlgCOFast = 'Faster Code';
dlgCOSmaller = 'Smaller Code'; dlgCOSmaller = 'Smaller Code';
dlgTargetProc = 'Target Processor:'; dlgTargetProc = 'Target i386';
dlgTargetPlatform = 'Target Platform:';
dlgOptimiz = 'Optimizations:'; dlgOptimiz = 'Optimizations:';
dlgCOKeepVarsReg = 'Keep certain variables in registers'; dlgCOKeepVarsReg = 'Keep certain variables in registers';
dlgUncertOpt = 'Uncertain Optimizations'; dlgUncertOpt = 'Uncertain Optimizations';
@ -996,6 +997,7 @@ resourcestring
dlgLevel2Opt = 'Level 2 (Level 1 + Slower Optimizations)'; dlgLevel2Opt = 'Level 2 (Level 1 + Slower Optimizations)';
dlgLevel3Opt = 'Level 3 (Level 2 + Uncertain)'; dlgLevel3Opt = 'Level 3 (Level 2 + Uncertain)';
dlgTargetOS = 'Target OS'; dlgTargetOS = 'Target OS';
dlgTargetCPU = 'Target CPU';
dlgCODebugging = 'Debugging:'; dlgCODebugging = 'Debugging:';
dlgCOGDB = 'Generate Debugging Info For GDB (Slows Compiling)'; dlgCOGDB = 'Generate Debugging Info For GDB (Slows Compiling)';
dlgCODBX = 'Generate Debugging Info For DBX (Slows Compiling)'; dlgCODBX = 'Generate Debugging Info For DBX (Slows Compiling)';
@ -2873,4 +2875,3 @@ resourcestring
implementation implementation
end. end.

10
ideintf/helpfpdoc.pas
View File

@ -34,6 +34,7 @@ type
TFPDocHTMLHelpDatabase = class(THTMLHelpDatabase) TFPDocHTMLHelpDatabase = class(THTMLHelpDatabase)
public public
function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode; function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode;
QueryItem: THelpQueryItem;
var ErrMsg: string): TShowHelpResult; override; var ErrMsg: string): TShowHelpResult; override;
end; end;
@ -43,7 +44,8 @@ implementation
{ TFPDocHTMLHelpDatabase } { TFPDocHTMLHelpDatabase }
function TFPDocHTMLHelpDatabase.ShowHelp(Query: THelpQuery; BaseNode, function TFPDocHTMLHelpDatabase.ShowHelp(Query: THelpQuery; BaseNode,
NewNode: THelpNode; var ErrMsg: string): TShowHelpResult; NewNode: THelpNode; QueryItem: THelpQueryItem;
var ErrMsg: string): TShowHelpResult;
var var
ContextList: TPascalHelpContextList; ContextList: TPascalHelpContextList;
UnitName: String; UnitName: String;
@ -55,9 +57,9 @@ var
p: LongInt; p: LongInt;
begin begin
if (Query is THelpQueryPascalContexts) if (Query is THelpQueryPascalContexts)
and (NewNode.QueryItem is TPascalHelpContextList) then begin and (QueryItem is TPascalHelpContextList) then begin
// a pascal context query // a pascal context query
ContextList:=TPascalHelpContextList(NewNode.QueryItem); ContextList:=TPascalHelpContextList(QueryItem);
if (ContextList.Count>0) and (ContextList.List[0].Descriptor=pihcFilename) if (ContextList.Count>0) and (ContextList.List[0].Descriptor=pihcFilename)
then begin then begin
// extract unit filename // extract unit filename
@ -121,7 +123,7 @@ begin
end; end;
end; end;
// otherwise use default // otherwise use default
Result:=inherited ShowHelp(Query, BaseNode, NewNode, ErrMsg); Result:=inherited ShowHelp(Query, BaseNode, NewNode, QueryItem, ErrMsg);
end; end;
end. end.

4
ideintf/helphtml.pas
View File

@ -40,6 +40,7 @@ type
function ShowURL(const URL, Title: string; function ShowURL(const URL, Title: string;
var ErrMsg: string): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode; function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode;
QueryItem: THelpQueryItem;
var ErrMsg: string): TShowHelpResult; override; var ErrMsg: string): TShowHelpResult; override;
function GetEffectiveBaseURL: string; function GetEffectiveBaseURL: string;
procedure Load(Storage: TConfigStorage); override; procedure Load(Storage: TConfigStorage); override;
@ -160,7 +161,8 @@ begin
end; end;
function THTMLHelpDatabase.ShowHelp(Query: THelpQuery; function THTMLHelpDatabase.ShowHelp(Query: THelpQuery;
BaseNode, NewNode: THelpNode; var ErrMsg: string): TShowHelpResult; BaseNode, NewNode: THelpNode; QueryItem: THelpQueryItem;
var ErrMsg: string): TShowHelpResult;
begin begin
ErrMsg:=''; ErrMsg:='';
Result:=shrContextNotFound; Result:=shrContextNotFound;

349
ideintf/helpintf.pas
View File

@ -47,6 +47,14 @@ type
TShowHelpResults = set of TShowHelpResult; TShowHelpResults = set of TShowHelpResult;
{ THelpQueryItem }
THelpQueryItem = class
public
function AsString: string; virtual; abstract;
function IsEqual(QueryItem: THelpQueryItem): boolean; virtual;
end;
{ TPascalHelpContextList } { TPascalHelpContextList }
TPascalHelpContextType = ( TPascalHelpContextType = (
@ -65,7 +73,7 @@ type
end; end;
TPascalHelpContextPtr = ^TPascalHelpContext; TPascalHelpContextPtr = ^TPascalHelpContext;
TPascalHelpContextList = class TPascalHelpContextList = class(THelpQueryItem)
private private
FCount: integer; FCount: integer;
// TODO: convert to dynamic array, when fpc 1.0 support is removed. // TODO: convert to dynamic array, when fpc 1.0 support is removed.
@ -76,8 +84,9 @@ type
procedure Insert(Index: integer; const Context: TPascalHelpContext); procedure Insert(Index: integer; const Context: TPascalHelpContext);
procedure Clear; procedure Clear;
destructor Destroy; override; destructor Destroy; override;
function IsEqual(AList: TPascalHelpContextList): boolean; function IsEqual(QueryItem: THelpQueryItem): boolean; override;
function CompareList(AList: TPascalHelpContextList): integer; function CompareList(AList: TPascalHelpContextList): integer;
function AsString: string; override;
public public
property Count: integer read FCount; property Count: integer read FCount;
property Items[Index: integer]: TPascalHelpContext read GetItems; property Items[Index: integer]: TPascalHelpContext read GetItems;
@ -101,10 +110,12 @@ type
hntURLContext // URL and Context valid, ignore ID hntURLContext // URL and Context valid, ignore ID
); );
{ THelpNode }
THelpNode = class(TPersistent) THelpNode = class(TPersistent)
private private
FContext: THelpContext; FContext: THelpContext;
FQueryItem: TObject;
FURL: string; FURL: string;
FHelpType: THelpNodeType; FHelpType: THelpNodeType;
fID: string; fID: string;
@ -130,6 +141,7 @@ type
function URLValid: boolean; function URLValid: boolean;
function IDValid: boolean; function IDValid: boolean;
function ContextValid: boolean; function ContextValid: boolean;
function AsString: string;
procedure Assign(Source: TPersistent); override; procedure Assign(Source: TPersistent); override;
published published
property Title: string read FTitle write FTitle; property Title: string read FTitle write FTitle;
@ -137,7 +149,44 @@ type
property URL: string read FURL write FURL; property URL: string read FURL write FURL;
property ID: string read fID write fID; property ID: string read fID write fID;
property Context: THelpContext read FContext write FContext; property Context: THelpContext read FContext write FContext;
property QueryItem: TObject read FQueryItem write FQueryItem; end;
{ THelpNodeQuery }
THelpNodeQuery = class
private
FNode: THelpNode;
FQueryItem: THelpQueryItem;
public
constructor Create;
constructor Create(TheNode: THelpNode; TheQueryItem: THelpQueryItem);
function IsEqual(TheNode: THelpNode; TheQueryItem: THelpQueryItem): boolean;
function IsEqual(NodeQuery: THelpNodeQuery): boolean;
function AsString: string;
property Node: THelpNode read FNode write FNode;
property QueryItem: THelpQueryItem read FQueryItem write FQueryItem;
end;
{ THelpNodeQueryList }
THelpNodeQueryList = class
private
fItems: TFPList;
function GetItems(Index: integer): THelpNodeQuery;
procedure SetItems(Index: integer; const AValue: THelpNodeQuery);
public
constructor Create;
destructor Destroy; override;
function Count: integer;
function Add(NodeQuery: THelpNodeQuery): integer;
function Add(Node: THelpNode; QueryItem: THelpQueryItem): integer;
procedure Delete(Index: integer);
function IndexOf(NodeQuery: THelpNodeQuery): integer;
function IndexOf(Node: THelpNode; QueryItem: THelpQueryItem): integer;
procedure Clear;
property Items[Index: integer]: THelpNodeQuery read GetItems write SetItems; default;
end; end;
@ -432,26 +481,27 @@ type
procedure ShowTableOfContents; virtual; procedure ShowTableOfContents; virtual;
procedure ShowError(ShowResult: TShowHelpResult; const ErrMsg: string); virtual; procedure ShowError(ShowResult: TShowHelpResult; const ErrMsg: string); virtual;
function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode; function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode;
QueryItem: THelpQueryItem;
var ErrMsg: string): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
function ShowHelpFile(Query: THelpQuery; BaseNode: THelpNode; function ShowHelpFile(Query: THelpQuery; BaseNode: THelpNode;
const Title, Filename: string; const Title, Filename: string;
var ErrMsg: string): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
function SupportsMimeType(const AMimeType: string): boolean; virtual; function SupportsMimeType(const AMimeType: string): boolean; virtual;
function GetNodesForKeyword(const HelpKeyword: string; function GetNodesForKeyword(const HelpKeyword: string;
var ListOfNodes: TList; var ErrMsg: string var ListOfNodes: THelpNodeQueryList;
): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
function GetNodesForContext(HelpContext: THelpContext; function GetNodesForContext(HelpContext: THelpContext;
var ListOfNodes: TList; var ErrMsg: string var ListOfNodes: THelpNodeQueryList;
): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
function GetNodesForPascalContexts(ListOfPascalHelpContextList: TList; function GetNodesForPascalContexts(ListOfPascalHelpContextList: TList;
var ListOfNodes: TList; var ListOfNodes: THelpNodeQueryList;
var ErrMsg: string): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
function GetNodesForClass(AClass: TClass; function GetNodesForClass(AClass: TClass;
var ListOfNodes: TList; var ErrMsg: string var ListOfNodes: THelpNodeQueryList;
): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
function GetNodesForMessage(const AMessage: string; MessageParts: TStrings; function GetNodesForMessage(const AMessage: string; MessageParts: TStrings;
var ListOfNodes: TList; var ErrMsg: string var ListOfNodes: THelpNodeQueryList;
): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
function FindViewer(const MimeType: string; var ErrMsg: string; function FindViewer(const MimeType: string; var ErrMsg: string;
var Viewer: THelpViewer): TShowHelpResult; virtual; var Viewer: THelpViewer): TShowHelpResult; virtual;
public public
@ -478,6 +528,9 @@ type
{ THelpDatabases { THelpDatabases
Class for storing all registered THelpDatabase } Class for storing all registered THelpDatabase }
{ THelpDatabases }
THelpDatabases = class THelpDatabases = class
private private
FItems: TList; FItems: TList;
@ -505,7 +558,7 @@ type
function GetBaseDirectoryForBasePathObject(BasePathObject: TObject): string; virtual; function GetBaseDirectoryForBasePathObject(BasePathObject: TObject): string; virtual;
public public
// show help for ... // show help for ...
function ShowHelpForNodes(Query: THelpQuery; Nodes: TList; function ShowHelpForNodes(Query: THelpQuery; Nodes: THelpNodeQueryList;
var ErrMsg: string): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
function ShowHelpForQuery(Query: THelpQuery; AutoFreeQuery: boolean; function ShowHelpForQuery(Query: THelpQuery; AutoFreeQuery: boolean;
var ErrMsg: string): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
@ -523,23 +576,24 @@ type
var ErrMsg: string): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
// search registered items in all databases // search registered items in all databases
function GetNodesForKeyword(const HelpKeyword: string; function GetNodesForKeyword(const HelpKeyword: string;
var ListOfNodes: TList; var ErrMsg: string var ListOfNodes: THelpNodeQueryList;
): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
function GetNodesForContext(HelpContext: THelpContext; function GetNodesForContext(HelpContext: THelpContext;
var ListOfNodes: TList; var ErrMsg: string var ListOfNodes: THelpNodeQueryList;
): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
function GetNodesForPascalContexts(ListOfPascalHelpContextList: TList; function GetNodesForPascalContexts(ListOfPascalHelpContextList: TList;
var ListOfNodes: TList; var ListOfNodes: THelpNodeQueryList;
var ErrMsg: string): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
function GetNodesForClass(AClass: TClass; function GetNodesForClass(AClass: TClass;
var ListOfNodes: TList; var ErrMsg: string var ListOfNodes: THelpNodeQueryList;
): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
function GetNodesForMessage(const AMessage: string; MessageParts: TStrings; function GetNodesForMessage(const AMessage: string; MessageParts: TStrings;
var ListOfNodes: TList; var ErrMsg: string var ListOfNodes: THelpNodeQueryList;
): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
function ShowHelpSelector(Query: THelpQuery; Nodes: TList; function ShowHelpSelector(Query: THelpQuery; Nodes: THelpNodeQueryList;
var ErrMsg: string; var ErrMsg: string;
var Selection: THelpNode): TShowHelpResult; virtual; var Selection: THelpNodeQuery
): TShowHelpResult; virtual;
public public
// registration of THelpDatabaseClass // registration of THelpDatabaseClass
procedure RegisterHelpDatabaseClass(NewHelpDB: THelpDatabaseClass); procedure RegisterHelpDatabaseClass(NewHelpDB: THelpDatabaseClass);
@ -619,6 +673,22 @@ type
TOnFindDefaultBrowser = procedure(var DefaultBrowser, Params: string) of object; TOnFindDefaultBrowser = procedure(var DefaultBrowser, Params: string) of object;
{ TBaseHelpManager }
TBaseHelpManager = class(TComponent)
public
procedure ConnectMainBarEvents; virtual; abstract;
procedure LoadHelpOptions; virtual; abstract;
procedure SaveHelpOptions; virtual; abstract;
function ShowHelpForSourcePosition(const Filename: string;
const CodePos: TPoint;
var ErrMsg: string): TShowHelpResult; virtual; abstract;
procedure ShowHelpForMessage(Line: integer); virtual; abstract;
end;
var var
HelpDatabases: THelpDatabases; // initialized by the IDE HelpDatabases: THelpDatabases; // initialized by the IDE
HelpViewers: THelpViewers; // initialized by the IDE HelpViewers: THelpViewers; // initialized by the IDE
@ -913,6 +983,18 @@ begin
List.Add(AnObject); List.Add(AnObject);
end; end;
procedure CreateNodeQueryListAndAdd(const ANode: THelpNode;
const QueryItem: THelpQueryItem;
var List: THelpNodeQueryList; OnlyIfNotExists: boolean);
begin
if List=nil then
List:=THelpNodeQueryList.Create
else if OnlyIfNotExists and (List.IndexOf(ANode,QueryItem)>=0) then
exit;
List.Add(ANode,QueryItem);
end;
{ THelpDatabase } { THelpDatabase }
@ -1004,7 +1086,7 @@ begin
ErrMsg:=''; ErrMsg:='';
Query:=THelpQueryTOC.Create(ID,TOCNode); Query:=THelpQueryTOC.Create(ID,TOCNode);
try try
ShowResult:=ShowHelp(Query,nil,TOCNode,ErrMsg); ShowResult:=ShowHelp(Query,nil,TOCNode,nil,ErrMsg);
finally finally
Query.Free; Query.Free;
end; end;
@ -1022,7 +1104,7 @@ begin
end; end;
function THelpDatabase.ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode; function THelpDatabase.ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode;
var ErrMsg: string): TShowHelpResult; QueryItem: THelpQueryItem; var ErrMsg: string): TShowHelpResult;
begin begin
ErrMsg:=''; ErrMsg:='';
Result:=shrContextNotFound; Result:=shrContextNotFound;
@ -1035,7 +1117,7 @@ var
begin begin
FileNode:=THelpNode.CreateURL(Self,Title,FilenameToURL(Filename)); FileNode:=THelpNode.CreateURL(Self,Title,FilenameToURL(Filename));
try try
Result:=ShowHelp(Query,BaseNode,FileNode,ErrMsg); Result:=ShowHelp(Query,BaseNode,FileNode,nil,ErrMsg);
finally finally
FileNode.Free; FileNode.Free;
end; end;
@ -1049,7 +1131,7 @@ begin
end; end;
function THelpDatabase.GetNodesForKeyword(const HelpKeyword: string; function THelpDatabase.GetNodesForKeyword(const HelpKeyword: string;
var ListOfNodes: TList; var ErrMsg: string): TShowHelpResult; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
// if ListOfNodes<>nil new nodes will be appended // if ListOfNodes<>nil new nodes will be appended
// if ListOfNodes=nil and nodes exists a new list will be created // if ListOfNodes=nil and nodes exists a new list will be created
var var
@ -1064,13 +1146,13 @@ begin
Node:=THelpDBItem(FSearchItems[i]).Node; Node:=THelpDBItem(FSearchItems[i]).Node;
if (Node=nil) or (not Node.IDValid) then continue; if (Node=nil) or (not Node.IDValid) then continue;
if AnsiCompareText(Node.ID,HelpKeyword)<>0 then continue; if AnsiCompareText(Node.ID,HelpKeyword)<>0 then continue;
CreateListAndAdd(Node,ListOfNodes,true); CreateNodeQueryListAndAdd(Node,nil,ListOfNodes,true);
end; end;
end; end;
end; end;
function THelpDatabase.GetNodesForContext(HelpContext: THelpContext; function THelpDatabase.GetNodesForContext(HelpContext: THelpContext;
var ListOfNodes: TList; var ErrMsg: string): TShowHelpResult; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
// if ListOfNodes<>nil new nodes will be appended // if ListOfNodes<>nil new nodes will be appended
// if ListOfNodes=nil and nodes exists a new list will be created // if ListOfNodes=nil and nodes exists a new list will be created
var var
@ -1085,14 +1167,14 @@ begin
Node:=THelpDBItem(FSearchItems[i]).Node; Node:=THelpDBItem(FSearchItems[i]).Node;
if (Node=nil) or (not Node.ContextValid) then continue; if (Node=nil) or (not Node.ContextValid) then continue;
if Node.Context<>HelpContext then continue; if Node.Context<>HelpContext then continue;
CreateListAndAdd(Node,ListOfNodes,true); CreateNodeQueryListAndAdd(Node,nil,ListOfNodes,true);
end; end;
end; end;
end; end;
function THelpDatabase.GetNodesForPascalContexts( function THelpDatabase.GetNodesForPascalContexts(
ListOfPascalHelpContextList: TList; var ListOfNodes: TList; var ErrMsg: string ListOfPascalHelpContextList: TList; var ListOfNodes: THelpNodeQueryList;
): TShowHelpResult; var ErrMsg: string): TShowHelpResult;
// if ListOfNodes<>nil new nodes will be appended // if ListOfNodes<>nil new nodes will be appended
// if ListOfNodes=nil and nodes exists a new list will be created // if ListOfNodes=nil and nodes exists a new list will be created
var var
@ -1108,6 +1190,7 @@ begin
if (ListOfPascalHelpContextList=nil) if (ListOfPascalHelpContextList=nil)
or (ListOfPascalHelpContextList.Count=0) then exit; or (ListOfPascalHelpContextList.Count=0) then exit;
// add the registered nodes // add the registered nodes
//debugln('THelpDatabase.GetNodesForPascalContexts A ListOfPascalHelpContextList.Count=',dbgs(ListOfPascalHelpContextList.Count));
if FSearchItems<>nil then begin if FSearchItems<>nil then begin
// check every pascal context // check every pascal context
for j:=0 to ListOfPascalHelpContextList.Count-1 do begin for j:=0 to ListOfPascalHelpContextList.Count-1 do begin
@ -1123,8 +1206,8 @@ begin
Filename:=PascalContext.List[0].Context; Filename:=PascalContext.List[0].Context;
//debugln('THelpDatabase.GetNodesForPascalContexts B FileItem.ClassName=',FileItem.ClassName,' Filename=',Filename); //debugln('THelpDatabase.GetNodesForPascalContexts B FileItem.ClassName=',FileItem.ClassName,' Filename=',Filename);
if (FileItem.FileMatches(Filename)) then begin if (FileItem.FileMatches(Filename)) then begin
FileItem.Node.QueryItem:=PascalContext; CreateNodeQueryListAndAdd(FileItem.Node,PascalContext,ListOfNodes,true);
CreateListAndAdd(FileItem.Node,ListOfNodes,true); //debugln('THelpDatabase.GetNodesForPascalContexts C FileItem.ClassName=',FileItem.ClassName,' Filename=',Filename,' ',dbgs(ListOfNodes.Count),' ',TempNode.Title,' ',dbgs(TempNode));
end; end;
end; end;
end; end;
@ -1132,8 +1215,8 @@ begin
end; end;
end; end;
function THelpDatabase.GetNodesForClass(AClass: TClass; var ListOfNodes: TList; function THelpDatabase.GetNodesForClass(AClass: TClass;
var ErrMsg: string): TShowHelpResult; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
// if ListOfNodes<>nil new nodes will be appended // if ListOfNodes<>nil new nodes will be appended
// if ListOfNodes=nil and nodes exists a new list will be created // if ListOfNodes=nil and nodes exists a new list will be created
var var
@ -1148,13 +1231,13 @@ begin
SearchItem:=THelpDBItem(FSearchItems[i]); SearchItem:=THelpDBItem(FSearchItems[i]);
if not (SearchItem is THelpDBIClass) then continue; if not (SearchItem is THelpDBIClass) then continue;
if THelpDBIClass(SearchItem).TheClass<>AClass then continue; if THelpDBIClass(SearchItem).TheClass<>AClass then continue;
CreateListAndAdd(SearchItem.Node,ListOfNodes,true); CreateNodeQueryListAndAdd(SearchItem.Node,nil,ListOfNodes,true);
end; end;
end; end;
end; end;
function THelpDatabase.GetNodesForMessage(const AMessage: string; function THelpDatabase.GetNodesForMessage(const AMessage: string;
MessageParts: TStrings; var ListOfNodes: TList; MessageParts: TStrings; var ListOfNodes: THelpNodeQueryList;
var ErrMsg: string): TShowHelpResult; var ErrMsg: string): TShowHelpResult;
// if ListOfNodes<>nil new nodes will be appended // if ListOfNodes<>nil new nodes will be appended
// if ListOfNodes=nil and nodes exists a new list will be created // if ListOfNodes=nil and nodes exists a new list will be created
@ -1171,7 +1254,7 @@ begin
if not (SearchItem is THelpDBIMessage) then continue; if not (SearchItem is THelpDBIMessage) then continue;
if not THelpDBIMessage(SearchItem).MessageMatches(AMessage,MessageParts) if not THelpDBIMessage(SearchItem).MessageMatches(AMessage,MessageParts)
then continue; then continue;
CreateListAndAdd(SearchItem.Node,ListOfNodes,true); CreateNodeQueryListAndAdd(SearchItem.Node,nil,ListOfNodes,true);
end; end;
end; end;
end; end;
@ -1389,28 +1472,30 @@ begin
Result:=''; Result:='';
end; end;
function THelpDatabases.ShowHelpForNodes(Query: THelpQuery; Nodes: TList; function THelpDatabases.ShowHelpForNodes(Query: THelpQuery;
var ErrMsg: string): TShowHelpResult; Nodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
var var
Node: THelpNode; NodeQuery: THelpNodeQuery;
begin begin
// check if several nodes found // check if several nodes found
//debugln('THelpDatabases.ShowHelpForNodes A Nodes.Count=',dbgs(Nodes.Count));
NodeQuery:=nil;
if (Nodes.Count>1) then begin if (Nodes.Count>1) then begin
Node:=nil; Result:=ShowHelpSelector(Query,Nodes,ErrMsg,NodeQuery);
Result:=ShowHelpSelector(Query,Nodes,ErrMsg,Node);
if Result<>shrSuccess then exit; if Result<>shrSuccess then exit;
if Node=nil then exit; if NodeQuery=nil then exit;
end else begin end else begin
Node:=THelpNode(Nodes[0]); NodeQuery:=Nodes[0];
end; end;
// show node // show node
if Node.Owner=nil then begin if NodeQuery.Node.Owner=nil then begin
Result:=shrDatabaseNotFound; Result:=shrDatabaseNotFound;
ErrMsg:=Format(oisHelpHelpNodeHasNoHelpDatabase, ['"', Node.Title, '"']); ErrMsg:=Format(oisHelpHelpNodeHasNoHelpDatabase, ['"', NodeQuery.Node.Title, '"']);
exit; exit;
end; end;
Result:=Node.Owner.ShowHelp(Query,nil,Node,ErrMsg); Result:=NodeQuery.Node.Owner.ShowHelp(Query,nil,
NodeQuery.Node,NodeQuery.QueryItem,ErrMsg);
end; end;
function THelpDatabases.ShowHelpForQuery(Query: THelpQuery; function THelpDatabases.ShowHelpForQuery(Query: THelpQuery;
@ -1442,7 +1527,7 @@ end;
function THelpDatabases.ShowHelpForContext(Query: THelpQueryContext; function THelpDatabases.ShowHelpForContext(Query: THelpQueryContext;
var ErrMsg: string): TShowHelpResult; var ErrMsg: string): TShowHelpResult;
var var
Nodes: TList; Nodes: THelpNodeQueryList;
HelpDB: THelpDatabase; HelpDB: THelpDatabase;
begin begin
ErrMsg:=''; ErrMsg:='';
@ -1462,7 +1547,6 @@ begin
end; end;
// check if at least one node found // check if at least one node found
if (Nodes<>nil) then Nodes.Pack;
if (Nodes=nil) or (Nodes.Count=0) then begin if (Nodes=nil) or (Nodes.Count=0) then begin
Result:=shrContextNotFound; Result:=shrContextNotFound;
if Query.HelpDatabaseID<>'' then if Query.HelpDatabaseID<>'' then
@ -1483,7 +1567,7 @@ end;
function THelpDatabases.ShowHelpForKeyword(Query: THelpQueryKeyword; function THelpDatabases.ShowHelpForKeyword(Query: THelpQueryKeyword;
var ErrMsg: string): TShowHelpResult; var ErrMsg: string): TShowHelpResult;
var var
Nodes: TList; Nodes: THelpNodeQueryList;
HelpDB: THelpDatabase; HelpDB: THelpDatabase;
begin begin
ErrMsg:=''; ErrMsg:='';
@ -1503,7 +1587,6 @@ begin
end; end;
// check if at least one node found // check if at least one node found
if (Nodes<>nil) then Nodes.Pack;
if (Nodes=nil) or (Nodes.Count=0) then begin if (Nodes=nil) or (Nodes.Count=0) then begin
Result:=shrContextNotFound; Result:=shrContextNotFound;
if Query.HelpDatabaseID<>'' then if Query.HelpDatabaseID<>'' then
@ -1523,12 +1606,12 @@ end;
function THelpDatabases.ShowHelpForPascalContexts( function THelpDatabases.ShowHelpForPascalContexts(
Query: THelpQueryPascalContexts; var ErrMsg: string): TShowHelpResult; Query: THelpQueryPascalContexts; var ErrMsg: string): TShowHelpResult;
var var
Nodes: TList; Nodes: THelpNodeQueryList;
begin begin
ErrMsg:=''; ErrMsg:='';
Result:=shrSuccess; Result:=shrSuccess;
debugln('THelpDatabases.ShowHelpForPascalContexts A'); debugln('THelpDatabases.ShowHelpForPascalContexts A Count=',dbgs(Query.ListOfPascalHelpContextList.Count));
// search node // search node
Nodes:=nil; Nodes:=nil;
try try
@ -1536,8 +1619,8 @@ begin
ErrMsg); ErrMsg);
if Result<>shrSuccess then exit; if Result<>shrSuccess then exit;
debugln('THelpDatabases.ShowHelpForPascalContexts B Nodes.Count=',dbgs(Nodes.Count));
// check if at least one node found // check if at least one node found
if (Nodes<>nil) then Nodes.Pack;
if (Nodes=nil) or (Nodes.Count=0) then begin if (Nodes=nil) or (Nodes.Count=0) then begin
Result:=shrHelpNotFound; Result:=shrHelpNotFound;
ErrMsg:=format(oisHelpNoHelpFoundForSource, ErrMsg:=format(oisHelpNoHelpFoundForSource,
@ -1561,7 +1644,7 @@ end;
function THelpDatabases.ShowHelpForMessageLine(Query: THelpQueryMessage; function THelpDatabases.ShowHelpForMessageLine(Query: THelpQueryMessage;
var ErrMsg: string): TShowHelpResult; var ErrMsg: string): TShowHelpResult;
var var
Nodes: TList; Nodes: THelpNodeQueryList;
begin begin
ErrMsg:=''; ErrMsg:='';
Result:=shrSuccess; Result:=shrSuccess;
@ -1575,7 +1658,6 @@ begin
if Result<>shrSuccess then exit; if Result<>shrSuccess then exit;
// check if at least one node found // check if at least one node found
if (Nodes<>nil) then Nodes.Pack;
if (Nodes=nil) or (Nodes.Count=0) then begin if (Nodes=nil) or (Nodes.Count=0) then begin
// no node found for the message is not a bug // no node found for the message is not a bug
Result:=shrSuccess; Result:=shrSuccess;
@ -1592,7 +1674,7 @@ end;
function THelpDatabases.ShowHelpForClass(Query: THelpQueryClass; function THelpDatabases.ShowHelpForClass(Query: THelpQueryClass;
var ErrMsg: string): TShowHelpResult; var ErrMsg: string): TShowHelpResult;
var var
Nodes: TList; Nodes: THelpNodeQueryList;
begin begin
ErrMsg:=''; ErrMsg:='';
Result:=shrSuccess; Result:=shrSuccess;
@ -1605,7 +1687,6 @@ begin
if Result<>shrSuccess then exit; if Result<>shrSuccess then exit;
// check if at least one node found // check if at least one node found
if (Nodes<>nil) then Nodes.Pack;
if (Nodes=nil) or (Nodes.Count=0) then begin if (Nodes=nil) or (Nodes.Count=0) then begin
// no node found for the class is not a bug // no node found for the class is not a bug
Result:=shrSuccess; Result:=shrSuccess;
@ -1620,7 +1701,7 @@ begin
end; end;
function THelpDatabases.GetNodesForKeyword(const HelpKeyword: string; function THelpDatabases.GetNodesForKeyword(const HelpKeyword: string;
var ListOfNodes: TList; var ErrMsg: string): TShowHelpResult; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
// if ListOfNodes<>nil then new nodes will be appended // if ListOfNodes<>nil then new nodes will be appended
// if ListOfNodes=nil and nodes exists a new list will be created // if ListOfNodes=nil and nodes exists a new list will be created
var var
@ -1635,7 +1716,7 @@ begin
end; end;
function THelpDatabases.GetNodesForContext(HelpContext: THelpContext; function THelpDatabases.GetNodesForContext(HelpContext: THelpContext;
var ListOfNodes: TList; var ErrMsg: string): TShowHelpResult; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
// if ListOfNodes<>nil then new nodes will be appended // if ListOfNodes<>nil then new nodes will be appended
// if ListOfNodes=nil and nodes exists a new list will be created // if ListOfNodes=nil and nodes exists a new list will be created
var var
@ -1650,7 +1731,7 @@ begin
end; end;
function THelpDatabases.GetNodesForPascalContexts( function THelpDatabases.GetNodesForPascalContexts(
ListOfPascalHelpContextList: TList; var ListOfNodes: TList; ListOfPascalHelpContextList: TList; var ListOfNodes: THelpNodeQueryList;
var ErrMsg: string): TShowHelpResult; var ErrMsg: string): TShowHelpResult;
// if ListOfNodes<>nil then new nodes will be appended // if ListOfNodes<>nil then new nodes will be appended
// if ListOfNodes=nil and nodes exists a new list will be created // if ListOfNodes=nil and nodes exists a new list will be created
@ -1667,7 +1748,7 @@ begin
end; end;
function THelpDatabases.GetNodesForClass(AClass: TClass; function THelpDatabases.GetNodesForClass(AClass: TClass;
var ListOfNodes: TList; var ErrMsg: string): TShowHelpResult; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
// if ListOfNodes<>nil then new nodes will be appended // if ListOfNodes<>nil then new nodes will be appended
// if ListOfNodes=nil and nodes exists a new list will be created // if ListOfNodes=nil and nodes exists a new list will be created
var var
@ -1682,7 +1763,7 @@ begin
end; end;
function THelpDatabases.GetNodesForMessage(const AMessage: string; function THelpDatabases.GetNodesForMessage(const AMessage: string;
MessageParts: TStrings; var ListOfNodes: TList; MessageParts: TStrings; var ListOfNodes: THelpNodeQueryList;
var ErrMsg: string): TShowHelpResult; var ErrMsg: string): TShowHelpResult;
// if ListOfNodes<>nil then new nodes will be appended // if ListOfNodes<>nil then new nodes will be appended
// if ListOfNodes=nil and nodes exists a new list will be created // if ListOfNodes=nil and nodes exists a new list will be created
@ -1698,8 +1779,9 @@ begin
end; end;
end; end;
function THelpDatabases.ShowHelpSelector(Query: THelpQuery; Nodes: TList; function THelpDatabases.ShowHelpSelector(Query: THelpQuery;
var ErrMsg: string; var Selection: THelpNode): TShowHelpResult; Nodes: THelpNodeQueryList; var ErrMsg: string;
var Selection: THelpNodeQuery): TShowHelpResult;
// Nodes is a list of THelpNode // Nodes is a list of THelpNode
begin begin
Result:=shrSelectorError; Result:=shrSelectorError;
@ -2027,6 +2109,11 @@ begin
Result:=FHelpType in [hntURLIDContext,hntURLContext,hntContext]; Result:=FHelpType in [hntURLIDContext,hntURLContext,hntContext];
end; end;
function THelpNode.AsString: string;
begin
Result:=Title;
end;
procedure THelpNode.Assign(Source: TPersistent); procedure THelpNode.Assign(Source: TPersistent);
var var
Node: THelpNode; Node: THelpNode;
@ -2036,6 +2123,7 @@ begin
FHelpType:=Node.HelpType; FHelpType:=Node.HelpType;
FTitle:=Node.Title; FTitle:=Node.Title;
FURL:=Node.URL; FURL:=Node.URL;
FID:=Node.ID;
FContext:=Node.Context; FContext:=Node.Context;
end else end else
inherited Assign(Source); inherited Assign(Source);
@ -2099,9 +2187,10 @@ begin
inherited Destroy; inherited Destroy;
end; end;
function TPascalHelpContextList.IsEqual(AList: TPascalHelpContextList): boolean; function TPascalHelpContextList.IsEqual(QueryItem: THelpQueryItem): boolean;
begin begin
Result:=CompareList(AList)=0; Result:=(QueryItem is TPascalHelpContextList)
and (CompareList(TPascalHelpContextList(QueryItem))=0);
end; end;
function TPascalHelpContextList.CompareList(AList: TPascalHelpContextList function TPascalHelpContextList.CompareList(AList: TPascalHelpContextList
@ -2129,6 +2218,14 @@ begin
Result:=1; Result:=1;
end; end;
function TPascalHelpContextList.AsString: string;
begin
Result:='';
if Count>0 then begin
Result:=fItems[0].Context;
end;
end;
{ THelpDBISourceFile } { THelpDBISourceFile }
procedure THelpDBISourceFile.SetFilename(const AValue: string); procedure THelpDBISourceFile.SetFilename(const AValue: string);
@ -2323,6 +2420,116 @@ begin
Result:=REMatches(TheMessage,Expression,ModifierStr); Result:=REMatches(TheMessage,Expression,ModifierStr);
end; end;
{ THelpNodeQuery }
constructor THelpNodeQuery.Create;
begin
end;
constructor THelpNodeQuery.Create(TheNode: THelpNode;
TheQueryItem: THelpQueryItem);
begin
Create;
FNode:=TheNode;
FQueryItem:=TheQueryItem;
end;
function THelpNodeQuery.IsEqual(TheNode: THelpNode; TheQueryItem: THelpQueryItem
): boolean;
begin
Result:=(Node=TheNode) and (QueryItem.IsEqual(TheQueryItem))
end;
function THelpNodeQuery.IsEqual(NodeQuery: THelpNodeQuery): boolean;
begin
Result:=IsEqual(NodeQuery.Node,NodeQuery.QueryItem)
end;
function THelpNodeQuery.AsString: string;
begin
Result:=Node.AsString;
if QueryItem<>nil then
Result:=Result+' ('+QueryItem.AsString+')';
end;
{ THelpNodeQueryList }
function THelpNodeQueryList.GetItems(Index: integer): THelpNodeQuery;
begin
Result:=THelpNodeQuery(fItems[Index]);
end;
procedure THelpNodeQueryList.SetItems(Index: integer;
const AValue: THelpNodeQuery);
begin
fItems[Index]:=AValue;
end;
constructor THelpNodeQueryList.Create;
begin
fItems:=TFPList.Create;
end;
destructor THelpNodeQueryList.Destroy;
begin
Clear;
fItems.Free;
inherited Destroy;
end;
function THelpNodeQueryList.Count: integer;
begin
Result:=fItems.Count;
end;
function THelpNodeQueryList.Add(NodeQuery: THelpNodeQuery): integer;
begin
Result:=fItems.Add(NodeQuery);
end;
function THelpNodeQueryList.Add(Node: THelpNode; QueryItem: THelpQueryItem
): integer;
begin
Result:=Add(THelpNodeQuery.Create(Node,QueryItem));
end;
procedure THelpNodeQueryList.Delete(Index: integer);
begin
TObject(fItems[Index]).Free;
fItems.Delete(Index);
end;
function THelpNodeQueryList.IndexOf(NodeQuery: THelpNodeQuery): integer;
begin
Result:=Count;
while (Result>=0) and (not Items[Result].IsEqual(NodeQuery)) do
dec(Result);
end;
function THelpNodeQueryList.IndexOf(Node: THelpNode; QueryItem: THelpQueryItem
): integer;
begin
Result:=Count-1;
while (Result>=0) and (not Items[Result].IsEqual(Node,QueryItem)) do
dec(Result);
end;
procedure THelpNodeQueryList.Clear;
var
i: Integer;
begin
for i:=0 to Count-1 do TObject(fItems[i]).Free;
fItems.Clear;
end;
{ THelpQueryItem }
function THelpQueryItem.IsEqual(QueryItem: THelpQueryItem): boolean;
begin
Result:=AsString=QueryItem.AsString;
end;
initialization initialization
HelpDatabases:=nil; HelpDatabases:=nil;