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

implemented simple HTML help viewer

Browse Source 
git-svn-id: trunk@5831 -
This commit is contained in:
mattias 2004-08-21 23:16:11 +00:00
parent 79ef1adaaf
commit d0ded429f3
27 changed files with 1814 additions and 344 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
.gitattributes vendored
View File

@ -338,6 +338,9 @@ docs/RemoteDebugging.txt svneol=native#text/plain
docs/html/update_gtkintf_html.sh -text svneol=native#application/x-sh
docs/html/update_html.sh -text svneol=native#application/x-sh
docs/html/update_lcl_html.sh -text svneol=native#application/x-sh
docs/images/cheetah1.png -text svneol=unset#image/png
docs/images/laztitle.jpg -text svneol=unset#image/jpeg
docs/index.html svneol=native#text/html
docs/xml/lcl/actnlist.xml svneol=native#text/xml
docs/xml/lcl/allunits.xml svneol=native#text/xml
docs/xml/lcl/arrow.xml svneol=native#text/xml
@ -560,9 +563,10 @@ ide/formeditor.pp svneol=native#text/pascal
ide/frmsearch.lfm svneol=native#text/plain
ide/frmsearch.lrs svneol=native#text/pascal
ide/frmsearch.pas svneol=native#text/pascal
ide/global.inc svneol=native#text/pascal
ide/global.pp svneol=native#text/pascal
ide/helpmanager.pas svneol=native#text/pascal
ide/helpoptions.lfm svneol=native#text/plain
ide/helpoptions.lrs svneol=native#text/pascal
ide/helpoptions.pas svneol=native#text/pascal
ide/idedefs.pas svneol=native#text/pascal
ide/ideoptiondefs.pas svneol=native#text/pascal
ide/ideprocs.pp svneol=native#text/pascal
@ -647,6 +651,7 @@ ideintf/columndlg.pp svneol=native#text/pascal
ideintf/componenteditors.pas svneol=native#text/pascal
ideintf/componentreg.pas svneol=native#text/pascal
ideintf/componenttreeview.pas svneol=native#text/pascal
ideintf/configstorage.pas svneol=native#text/pascal
ideintf/formeditingintf.pas svneol=native#text/pascal
ideintf/graphpropedits.pas svneol=native#text/pascal
ideintf/helphtml.pas svneol=native#text/pascal

11
README
View File

@ -14,11 +14,18 @@ and many more).
The LCL currently supports linux (gtk, gnome and little bit gtk2) and windows.
--------------------------------------------------------------------------------
Installation:
Compilation:
You don't need ./configure, just do
[]$ make clean all
This will create the lazarus executable. Start it and enjoy.
--------------------------------------------------------------------------------
Installation and Requirements:
See the file docs/INSTALL.
--------------------------------------------------------------------------------
Usage:

58
components/rtticontrols/rttictrls.pas
View File

@ -1152,16 +1152,7 @@ type
{ TTICustomPropertyGrid }
TTICustomPropertyGrid = class(TOICustomPropertyGrid)
private
FAutoFreeHook: boolean;
function GetTIObject: TPersistent;
procedure SetAutoFreeHook(const AValue: boolean);
procedure SetTIObject(const AValue: TPersistent);
public
constructor Create(TheOwner: TComponent); override;
property TIObject: TPersistent read GetTIObject write SetTIObject;
property AutoFreeHook: boolean read FAutoFreeHook write SetAutoFreeHook;
TTICustomPropertyGrid = class(TCustomPropertiesGrid)
end;
@ -2529,53 +2520,6 @@ begin
FLink.SaveToProperty;
end;
{ TTICustomPropertyGrid }
procedure TTICustomPropertyGrid.SetTIObject(const AValue: TPersistent);
var
NewSelection: TPersistentSelectionList;
begin
if (TIObject=AValue) then begin
if ((AValue<>nil) and (Selection.Count=1) and (Selection[0]=AValue))
or (AValue=nil) then
exit;
end;
if PropertyEditorHook=nil then
PropertyEditorHook:=TPropertyEditorHook.Create;
PropertyEditorHook.LookupRoot:=AValue;
if (AValue<>nil) and ((Selection.Count<>1) or (Selection[0]<>AValue)) then
begin
NewSelection:=TPersistentSelectionList.Create;
try
if AValue<>nil then
NewSelection.Add(AValue);
Selection:=NewSelection;
finally
NewSelection.Free;
end;
end;
end;
function TTICustomPropertyGrid.GetTIObject: TPersistent;
begin
if PropertyEditorHook<>nil then Result:=PropertyEditorHook.LookupRoot;
end;
procedure TTICustomPropertyGrid.SetAutoFreeHook(const AValue: boolean);
begin
if FAutoFreeHook=AValue then exit;
FAutoFreeHook:=AValue;
end;
constructor TTICustomPropertyGrid.Create(TheOwner: TComponent);
var
Hook: TPropertyEditorHook;
begin
Hook:=TPropertyEditorHook.Create;
AutoFreeHook:=true;
CreateWithParams(TheOwner,Hook,AllTypeKinds,25);
end;
{ TTICustomSpinEdit }
procedure TTICustomSpinEdit.SetLink(const AValue: TPropertyLink);

1
docs/INSTALL
View File

@ -61,7 +61,6 @@ properly:
2. Apple X11: On a fresh system: choose "Customize" in the install-dialogue,
check "X11". On an already installed system: download at
http://www.apple.com/downloads/macosx/apple/x11formacosx.html
The X11-Application is in /Applications/Utilities/X11.
3. gtk1.2: The gtk is installed easily with a package manager like fink.

BIN
docs/images/cheetah1.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 92 KiB

BIN
docs/images/laztitle.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 10 KiB

64
docs/index.html Normal file
View File

@ -0,0 +1,64 @@
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="content-type"
content="text/html; charset=ISO-8859-1">
<title>Lazarus</title>
<meta name="author" content="Mattias Gaertner">
<meta name="description" content="Start Page">
</head>
<body link="#993300" vlink="#660000" alink="#006600"
style="color: rgb(0, 0, 0); background-color: rgb(255, 255, 255);">
<table cellpadding="2" cellspacing="2" border="0"
style="text-align: left; width: 100%;">
<tbody>
<tr align="center">
<td style="vertical-align: top; background-color: rgb(0, 0, 0);"><big><span
style="font-family: helvetica,arial,sans-serif;"><img
src="file:///home/mattias/pascal/wichtig/lazarus/docs/images/laztitle.jpg"
title="" alt="The Lazarus Project" style="width: 744px; height: 76px;"></span></big><big><span
style="font-family: helvetica,arial,sans-serif;"><br>
<img
src="file:///home/mattias/pascal/wichtig/lazarus/docs/images/cheetah1.png"
title="" alt="Cheetah" style="width: 369px; height: 111px;"></span></big></td>
</tr>
<tr>
<td
style="vertical-align: top; background-color: rgb(255, 255, 255);"><big><span
style="font-family: helvetica,arial,sans-serif;"><br>
Welcome to Lazarus<br>
<br>
<small>Lazarus is a Rapid Application Development tool for Free
Pascal
and currently runs on Linux, Mac OS X, BSD and of course Windows.<br>
</small></span></big><span
style="font-family: helvetica,arial,sans-serif;">It is freely
available, open source and completely written in Free Pascal.</span><small><br
style="font-family: helvetica,arial,sans-serif;">
</small><br style="font-family: helvetica,arial,sans-serif;">
<span style="font-family: helvetica,arial,sans-serif;">The
official Lazarus site is </span><a
href="http://sourceforge.net/projects/netatalk/"
style="font-family: helvetica,arial,sans-serif;">http://www.lazarus.freepascal.org/</a><span
style="font-family: helvetica,arial,sans-serif;">.<br>
There is a wiki and a lot of information around Lazarus at <a
href="http://lazarus-ccr.sourceforge.net/">http://lazarus-ccr.sourceforge.net/</a>.<br>
Free Pascal can be found at <a href="http://www.freepascal.org/">http://www.freepascal.org/</a>.<br
style="font-family: helvetica,arial,sans-serif;">
</span><br style="font-family: helvetica,arial,sans-serif;">
<span style="font-family: helvetica,arial,sans-serif;">The
Lazarus
Component Library is licensed under the GNU Lesser General Public
License.</span><br style="font-family: helvetica,arial,sans-serif;">
<span style="font-family: helvetica,arial,sans-serif;">The
Lazarus IDE is licensed under the GNU General Public License.</span><br
style="font-family: helvetica,arial,sans-serif;">
<br style="font-family: helvetica,arial,sans-serif;">
</td>
</tr>
</tbody>
</table>
<big><span style="font-family: helvetica,arial,sans-serif;"><br>
</span></big><br>
</body>
</html>

54
ide/global.inc
View File

@ -1,54 +0,0 @@
(******************************************************************************
global.inc
******************************************************************************)
{ =============================================================================
$Log$
Revision 1.3 2001/01/31 13:03:33 lazarus
Commitng source with new editor.
Shane
Revision 1.2 2000/12/19 18:43:12 lazarus
Removed IDEEDITOR. This causes the PROJECT class to not function.
Saving projects no longer works.
I added TSourceNotebook and TSourceEditor. They do all the work for saving/closing/opening units. Somethings work but they are in early development.
Shane
Revision 1.1 2000/07/13 10:27:46 michael
+ Initial import
Revision 1.6 2000/07/09 20:18:55 lazarus
MWE:
+ added new controlselection
+ some fixes
~ some cleanup
Revision 1.5 2000/06/16 13:33:20 lazarus
Created a new method for adding controls to the toolbar to be dropped onto the form!
Shane
Revision 1.4 2000/06/14 18:04:44 lazarus
Now adds the code (genericly) when you drop a component on the form
Shane
Revision 1.3 2000/03/06 12:28:45 lazarus
Committed the real Global.inc file.
Shane
Revision 1.2 2000/03/06 00:05:05 lazarus
MWE: Added changes from Peter Dyson <peter@skel.demon.co.uk> for a new
release of mwEdit (0.92)
Revision 1.1 2000/03/03 22:47:31 lazarus
MWE:
A quick replacement for the original global.inc
}

123
ide/global.pp
View File

@ -1,123 +0,0 @@
{/***************************************************************************
global.pp - description
-------------------
begin : Tue Apr 6 1999
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
unit global;
{$mode objfpc}
interface
implementation
{$I global.inc}
end.
{ =============================================================================
$Log$
Revision 1.7 2003/05/03 23:00:33 mattias
localization
Revision 1.6 2002/05/10 06:57:41 lazarus
MG: updated licenses
Revision 1.5 2001/01/31 13:03:33 lazarus
Commitng source with new editor.
Shane
Revision 1.4 2000/12/19 18:43:12 lazarus
Removed IDEEDITOR. This causes the PROJECT class to not function.
Saving projects no longer works.
I added TSourceNotebook and TSourceEditor. They do all the work for saving/closing/opening units. Somethings work but they are in early development.
Shane
Revision 1.3 2000/12/01 18:12:40 lazarus
Modified Gloabal so TDesignForm isn't included anymore.
Shane
Revision 1.2 2000/12/01 15:50:39 lazarus
changed the TCOmponentInterface SetPropByName. It works for a few properties, but not all.
Shane
Revision 1.1 2000/07/13 10:27:47 michael
+ Initial import
Revision 1.13 2000/07/09 20:18:55 lazarus
MWE:
+ added new controlselection
+ some fixes
~ some cleanup
Revision 1.12 2000/06/16 13:33:20 lazarus
Created a new method for adding controls to the toolbar to be dropped onto the form!
Shane
Revision 1.10 2000/06/12 15:54:24 lazarus
Added grid dots to the form created via New Form.
Added the mouse speedbutton and when clicked they stay down.
Shane
Revision 1.9 2000/03/03 22:58:25 lazarus
MWE:
Fixed focussing problem.
LM-FOCUS was bound to the wrong signal
Added GetKeyState api func.
Now LCL knows if shift/trl/alt is pressed (might be handy for keyboard
selections ;-)
Revision 1.8 2000/03/03 20:22:02 lazarus
Trying to add TBitBtn
Shane
Revision 1.7 2000/03/01 21:54:05 lazarus
90% finished with SAVE PROJECT and OPEN PROJECT
Shane
Revision 1.6 2000/02/29 23:00:04 lazarus
Adding code for the ide.
Shane
Revision 1.5 1999/05/14 18:44:11 lazarus
*** empty log message ***
Revision 1.4 1999/05/07 05:46:51 lazarus
*** empty log message ***
Revision 1.3 1999/05/01 04:44:53 lazarus
*** empty log message ***
Revision 1.2 1999/04/18 05:42:09 lazarus
*** empty log message ***
Revision 1.1 1999/04/14 07:31:44 michael
+ Initial implementation
}

142
ide/helpmanager.pas
View File

@ -33,8 +33,10 @@ unit HelpManager;
interface
uses
Classes, SysUtils, Forms, Controls, Buttons, StdCtrls, LCLProc, HelpIntf,
IDEOptionDefs;
Classes, SysUtils, LCLProc, Forms, Controls, Buttons, StdCtrls, Dialogs,
HelpIntf, HelpHTML,
IDEOptionDefs, EnvironmentOpts, AboutFrm, Project, PackageDefs, MainBar,
HelpOptions, MainIntf;
type
{ TBaseHelpManager }
@ -44,7 +46,9 @@ type
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
public
procedure ConnectMainBarEvents;
procedure ConnectMainBarEvents; virtual;
procedure LoadHelpOptions; virtual; abstract;
procedure SaveHelpOptions; virtual; abstract;
end;
@ -54,16 +58,40 @@ type
public
function ShowHelpSelector(Nodes: TList; var ErrMsg: string;
var Selection: THelpNode): TShowHelpResult; override;
procedure ShowError(ShowResult: TShowHelpResult; const ErrMsg: string); override;
function GetBaseURLForBasePathObject(BasePathObject: TObject): string; override;
end;
{ THelpManager }
THelpManager = class(TBaseHelpManager)
// help menu of the IDE menu bar
procedure mnuHelpAboutLazarusClicked(Sender: TObject);
procedure mnuHelpConfigureHelpClicked(Sender: TObject);
procedure mnuHelpOnlineHelpClicked(Sender: TObject);
private
FMainHelpDB: THelpDatabase;
procedure RegisterIDEHelpDatabases;
procedure RegisterDefaultIDEHelpViewers;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure ConnectMainBarEvents; override;
procedure LoadHelpOptions; override;
procedure SaveHelpOptions; override;
procedure ShowLazarusHelpStartPage;
procedure ShowIDEHelpForContext(HelpContext: THelpContext);
procedure ShowIDEHelpForKeyword(const Keyword: string);
property MainHelpDB: THelpDatabase read FMainHelpDB;
end;
{ Help Contexts for IDE help }
const
lihcStartPage = 'StartPage';
var
HelpBoss: TBaseHelpManager;
@ -214,21 +242,129 @@ begin
end;
end;
procedure TIDEHelpDatabases.ShowError(ShowResult: TShowHelpResult;
const ErrMsg: string);
var
ErrorCaption: String;
begin
case ShowResult of
shrNone: ErrorCaption:='Error';
shrSuccess: exit;
shrDatabaseNotFound: ErrorCaption:='Help Database not found';
shrContextNotFound: ErrorCaption:='Help Context not found';
shrViewerNotFound: ErrorCaption:='Help Viewer not found';
shrHelpNotFound: ErrorCaption:='Help not found';
shrViewerError: ErrorCaption:='Help Viewer Error';
shrSelectorError: ErrorCaption:='Help Selector Error';
else ErrorCaption:='Unknown Error, please report this bug';
end;
MessageDlg(ErrorCaption,ErrMsg,mtError,[mbCancel],0);
end;
function TIDEHelpDatabases.GetBaseURLForBasePathObject(BasePathObject: TObject
): string;
begin
Result:='';
if (BasePathObject=HelpBoss) or (BasePathObject=MainIDEInterface) then
Result:=EnvironmentOptions.LazarusDirectory
else if BasePathObject is TProject then
Result:=TProject(BasePathObject).ProjectDirectory
else if BasePathObject is TLazPackage then
Result:=TLazPackage(BasePathObject).Directory;
Result:=FilenameToURL(Result);
end;
{ THelpManager }
procedure THelpManager.mnuHelpAboutLazarusClicked(Sender: TObject);
begin
ShowAboutForm;
end;
procedure THelpManager.mnuHelpConfigureHelpClicked(Sender: TObject);
begin
if ShowHelpOptionsDialog=mrOk then
SaveHelpOptions;
end;
procedure THelpManager.mnuHelpOnlineHelpClicked(Sender: TObject);
begin
ShowLazarusHelpStartPage;
end;
procedure THelpManager.RegisterIDEHelpDatabases;
var
HTMLHelp: THTMLHelpDatabase;
StartNode: THelpNode;
begin
FMainHelpDB:=HelpDatabases.CreateHelpDatabase('Lazarus IDE',THTMLHelpDatabase,
true);
HTMLHelp:=FMainHelpDB as THTMLHelpDatabase;
HTMLHelp.BasePathObject:=Self;
// nodes
StartNode:=THelpNode.CreateURLID(HTMLHelp,'Lazarus',
'file://docs/index.html',lihcStartPage);
HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,StartNode);
HTMLHelp.RegisterItemWithNode(StartNode);
end;
procedure THelpManager.RegisterDefaultIDEHelpViewers;
begin
HelpViewers.RegisterViewer(THTMLBrowserHelpViewer.Create);
end;
constructor THelpManager.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
HelpOpts:=THelpOptions.Create;
HelpOpts.SetDefaultFilename;
HelpDatabases:=TIDEHelpDatabases.Create;
HelpViewers:=THelpViewers.Create;
RegisterIDEHelpDatabases;
RegisterDefaultIDEHelpViewers;
end;
destructor THelpManager.Destroy;
begin
FreeThenNil(HelpDatabases);
FreeThenNil(HelpViewers);
FreeThenNil(HelpOpts);
inherited Destroy;
end;
procedure THelpManager.ConnectMainBarEvents;
begin
with MainIDEBar do begin
itmHelpAboutLazarus.OnClick := @mnuHelpAboutLazarusClicked;
itmHelpOnlineHelp.OnClick :=@mnuHelpOnlineHelpClicked;
itmHelpConfigureHelp.OnClick :=@mnuHelpConfigureHelpClicked;
end;
end;
procedure THelpManager.LoadHelpOptions;
begin
HelpOpts.Load;
end;
procedure THelpManager.SaveHelpOptions;
begin
HelpOpts.Save;
end;
procedure THelpManager.ShowLazarusHelpStartPage;
begin
ShowIDEHelpForKeyword(lihcStartPage);
end;
procedure THelpManager.ShowIDEHelpForContext(HelpContext: THelpContext);
begin
ShowHelpOrErrorForContext(MainHelpDB.ID,HelpContext);
end;
procedure THelpManager.ShowIDEHelpForKeyword(const Keyword: string);
begin
ShowHelpOrErrorForKeyword(MainHelpDB.ID,Keyword);
end;
end.

81
ide/helpoptions.lfm Normal file
View File

@ -0,0 +1,81 @@
object HelpOptionsDialog: THelpOptionsDialog
Caption = 'HelpOptionsDialog'
ClientHeight = 300
ClientWidth = 500
OnClose = HelpOptionsDialogClose
OnCreate = HelpOptionsDialogCreate
PixelsPerInch = 90
Position = poScreenCenter
HorzScrollBar.Page = 501
VertScrollBar.Page = 301
Left = 291
Height = 300
Top = 163
Width = 500
object OkButton: TButton
Anchors = [akRight, akBottom]
Caption = 'OkButton'
OnClick = OkButtonClick
TabOrder = 0
Left = 292
Height = 25
Top = 264
Width = 75
end
object CancelButton: TButton
Anchors = [akRight, akBottom]
Caption = 'CancelButton'
OnClick = CancelButtonClick
TabOrder = 1
Left = 388
Height = 25
Top = 264
Width = 75
end
object MainNotebook: TNotebook
Align = alTop
Anchors = [akTop, akLeft, akBottom]
PageIndex = 0
Height = 256
Width = 500
object ViewersPage: TPage
Caption = 'ViewersPage'
ClientWidth = 496
ClientHeight = 226
Left = 2
Height = 226
Top = 28
Width = 496
object ViewersListBox: TListBox
Anchors = [akTop, akLeft, akBottom]
ClickOnSelChange = False
OnSelectionChange = ViewersListBoxSelectionChange
TabOrder = 0
TopIndex = 18446744073709551615
Left = 8
Height = 180
Top = 36
Width = 149
end
object ViewersLabel: TLabel
Caption = 'ViewersLabel'
Left = 8
Height = 23
Top = 4
Width = 149
end
object ViewerPropsGroupBox: TGroupBox
Anchors = [akTop, akLeft, akRight, akBottom]
Caption = 'ViewerPropsGroupBox'
ClientHeight = 192
ClientWidth = 316
ParentColor = True
TabOrder = 2
Left = 168
Height = 209
Top = 7
Width = 320
end
end
end
end

28
ide/helpoptions.lrs Normal file
View File

@ -0,0 +1,28 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('THelpOptionsDialog','FORMDATA',[
'TPF0'#18'THelpOptionsDialog'#17'HelpOptionsDialog'#7'Caption'#6#17'HelpOptio'
+'nsDialog'#12'ClientHeight'#3','#1#11'ClientWidth'#3#244#1#7'OnClose'#7#22'H'
+'elpOptionsDialogClose'#8'OnCreate'#7#23'HelpOptionsDialogCreate'#13'PixelsP'
+'erInch'#2'Z'#8'Position'#7#14'poScreenCenter'#18'HorzScrollBar.Page'#3#245#1
+#18'VertScrollBar.Page'#3'-'#1#4'Left'#3'#'#1#6'Height'#3','#1#3'Top'#3#163#0
+#5'Width'#3#244#1#0#7'TButton'#8'OkButton'#7'Anchors'#11#7'akRight'#8'akBott'
+'om'#0#7'Caption'#6#8'OkButton'#7'OnClick'#7#13'OkButtonClick'#8'TabOrder'#2
+#0#4'Left'#3'$'#1#6'Height'#2#25#3'Top'#3#8#1#5'Width'#2'K'#0#0#7'TButton'#12
+'CancelButton'#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Caption'#6#12'Cancel'
+'Button'#7'OnClick'#7#17'CancelButtonClick'#8'TabOrder'#2#1#4'Left'#3#132#1#6
+'Height'#2#25#3'Top'#3#8#1#5'Width'#2'K'#0#0#9'TNotebook'#12'MainNotebook'#5
+'Align'#7#5'alTop'#7'Anchors'#11#5'akTop'#6'akLeft'#8'akBottom'#0#9'PageInde'
+'x'#2#0#6'Height'#3#0#1#5'Width'#3#244#1#0#5'TPage'#11'ViewersPage'#7'Captio'
+'n'#6#11'ViewersPage'#11'ClientWidth'#3#240#1#12'ClientHeight'#3#226#0#4'Lef'
+'t'#2#2#6'Height'#3#226#0#3'Top'#2#28#5'Width'#3#240#1#0#8'TListBox'#14'View'
+'ersListBox'#7'Anchors'#11#5'akTop'#6'akLeft'#8'akBottom'#0#16'ClickOnSelCha'
+'nge'#8#17'OnSelectionChange'#7#29'ViewersListBoxSelectionChange'#8'TabOrder'
+#2#0#8'TopIndex'#2#255#4'Left'#2#8#6'Height'#3#180#0#3'Top'#2'$'#5'Width'#3
+#149#0#0#0#6'TLabel'#12'ViewersLabel'#7'Caption'#6#12'ViewersLabel'#4'Left'#2
+#8#6'Height'#2#23#3'Top'#2#4#5'Width'#3#149#0#0#0#9'TGroupBox'#19'ViewerProp'
+'sGroupBox'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#7'Capt'
+'ion'#6#19'ViewerPropsGroupBox'#12'ClientHeight'#3#192#0#11'ClientWidth'#3'<'
+#1#11'ParentColor'#9#8'TabOrder'#2#2#4'Left'#3#168#0#6'Height'#3#209#0#3'Top'
+#2#7#5'Width'#3'@'#1#0#0#0#0#0
]);

308
ide/helpoptions.pas Normal file
View File

@ -0,0 +1,308 @@
{ /***************************************************************************
helpoptions.pas - Lazarus IDE unit
------------------------------------
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
- THelpOptions and THelpOptsDlg
}
unit HelpOptions;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
ExtCtrls, HelpIntf, Laz_XMLCfg, ObjectInspector,
LazConf, LazarusIDEStrConsts, IDEOptionDefs, StdCtrls;
type
{ THelpOptions }
THelpOptions = class
private
FFilename: string;
procedure SetFilename(const AValue: string);
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Load;
procedure Save;
procedure SetDefaultFilename;
procedure Assign(HelpOpts: THelpOptions);
function IsEqual(HelpOpts: THelpOptions): boolean;
function CreateCopy: THelpOptions;
public
property Filename: string read FFilename write SetFilename;
end;
{ THelpOptionsDialog }
THelpOptionsDialog = class(TForm)
ViewerPropsGroupBox: TGroupBox;
ViewersLabel: TLabel;
ViewersListBox: TListBox;
MainNotebook: TNotebook;
OkButton: TButton;
CancelButton: TButton;
ViewersPage: TPage;
procedure CancelButtonClick(Sender: TObject);
procedure HelpOptionsDialogClose(Sender: TObject;
var CloseAction: TCloseAction);
procedure HelpOptionsDialogCreate(Sender: TObject);
procedure OkButtonClick(Sender: TObject);
procedure ViewersListBoxSelectionChange(Sender: TObject; User: boolean);
private
public
ViewersPropertiesGrid: TCustomPropertiesGrid;
procedure FillViewersList;
procedure FillViewerPropGrid;
end;
var
HelpOpts: THelpOptions; // set by the IDE
const
HelpOptionsVersion = 1;
DefaultHelpOptsFile = 'helpoptions.xml';
function ShowHelpOptionsDialog: TModalResult;
implementation
function ShowHelpOptionsDialog: TModalResult;
var
HelpOptionsDialog: THelpOptionsDialog;
begin
HelpOptionsDialog:=THelpOptionsDialog.Create(nil);
try
Result:=HelpOptionsDialog.ShowModal;
finally
HelpOptionsDialog.Free;
end;
end;
{ THelpOptionsDialog }
procedure THelpOptionsDialog.HelpOptionsDialogCreate(Sender: TObject);
begin
IDEDialogLayoutList.ApplyLayout(Self,500,300);
Caption:=lisHlpOptsHelpOptions;
OkButton.Caption:=lisLazBuildOk;
CancelButton.Caption:=dlgCancel;
ViewersPage.Caption:=lisHlpOptsViewers;
ViewerPropsGroupBox.Caption:=lisHlpOptsProperties;
ViewersLabel.Caption:=lisHlpOptsViewers;
ViewersPropertiesGrid:=TCustomPropertiesGrid.Create(Self);
with ViewersPropertiesGrid do begin
Name:='ViewersPropertiesGrid';
Parent:=ViewerPropsGroupBox;
Align:=alClient;
end;
FillViewersList;
FillViewerPropGrid;
end;
procedure THelpOptionsDialog.OkButtonClick(Sender: TObject);
begin
ModalResult:=mrOk;
end;
procedure THelpOptionsDialog.ViewersListBoxSelectionChange(Sender: TObject;
User: boolean);
begin
FillViewerPropGrid;
end;
procedure THelpOptionsDialog.FillViewersList;
var
i: Integer;
Viewer: THelpViewer;
begin
if (HelpViewers=nil) then begin
ViewersListBox.Items.Clear;
exit;
end;
ViewersListBox.Items.BeginUpdate;
for i:=0 to HelpViewers.Count-1 do begin
Viewer:=HelpViewers[i];
if ViewersListBox.Items.Count>i then
ViewersListBox.Items[i]:=Viewer.GetLocalizedName
else
ViewersListBox.Items.Add(Viewer.GetLocalizedName);
end;
while ViewersListBox.Items.Count>HelpViewers.Count do
ViewersListBox.Items.Delete(ViewersListBox.Items.Count-1);
if (ViewersListBox.ItemIndex<0) and (ViewersListBox.Items.Count>0) then
ViewersListBox.ItemIndex:=0;
ViewersListBox.Items.EndUpdate;
end;
procedure THelpOptionsDialog.FillViewerPropGrid;
var
i: LongInt;
begin
i:=ViewersListBox.ItemIndex;
if (HelpViewers=nil) or (i<0) or (i>=HelpViewers.Count) then begin
ViewersPropertiesGrid.TIObject:=nil;
end else begin
ViewersPropertiesGrid.TIObject:=HelpViewers[i];
end;
end;
procedure THelpOptionsDialog.HelpOptionsDialogClose(Sender: TObject;
var CloseAction: TCloseAction);
begin
IDEDialogLayoutList.SaveLayout(Self);
end;
procedure THelpOptionsDialog.CancelButtonClick(Sender: TObject);
begin
// ToDo: restore backup
ModalResult:=mrCancel;
end;
{ THelpOptions }
procedure THelpOptions.SetFilename(const AValue: string);
begin
if FFilename=AValue then exit;
FFilename:=AValue;
end;
constructor THelpOptions.Create;
begin
Clear;
end;
destructor THelpOptions.Destroy;
begin
inherited Destroy;
end;
procedure THelpOptions.Clear;
begin
end;
procedure THelpOptions.Load;
var
XMLConfig: TXMLConfig;
FileVersion: integer;
Storage: TXMLOptionsStorage;
begin
try
XMLConfig:=TXMLConfig.Create(FFileName);
Storage:=nil;
try
FileVersion:=XMLConfig.GetValue('HelpOptions/Version/Value',0);
if (FileVersion<>0) and (FileVersion<HelpOptionsVersion) then
writeln('Note: Loading old Help options file', FFileName);
if HelpViewers<>nil then begin
Storage:=TXMLOptionsStorage.Create(XMLConfig,'Viewers');
HelpViewers.Load(Storage);
end;
finally
XMLConfig.Free;
Storage.Free;
end;
except
on E: Exception do begin
writeln('[THelpOptions.Load] error reading "',FFilename,'": ',E.Message);
end;
end;
end;
procedure THelpOptions.Save;
var
XMLConfig: TXMLConfig;
Storage: TXMLOptionsStorage;
begin
try
XMLConfig:=TXMLConfig.CreateClean(FFileName);
Storage:=nil;
try
XMLConfig.SetValue('HelpOptions/Version/Value',HelpOptionsVersion);
if HelpViewers<>nil then begin
Storage:=TXMLOptionsStorage.Create(XMLConfig,'Viewers');
HelpViewers.Save(Storage);
end;
XMLConfig.Flush;
finally
XMLConfig.Free;
Storage.Free;
end;
except
on E: Exception do begin
writeln('[THelpOptions.Save] error writing "',FFilename,'": ',E.Message);
end;
end;
end;
procedure THelpOptions.SetDefaultFilename;
var
ConfFileName: string;
begin
ConfFileName:=SetDirSeparators(
GetPrimaryConfigPath+'/'+DefaultHelpOptsFile);
CopySecondaryConfigFile(DefaultHelpOptsFile);
if (not FileExists(ConfFileName)) then begin
writeln('NOTE: help options config file not found - using defaults');
end;
FFilename:=ConfFilename;
end;
procedure THelpOptions.Assign(HelpOpts: THelpOptions);
begin
end;
function THelpOptions.IsEqual(HelpOpts: THelpOptions): boolean;
begin
Result:=true;
end;
function THelpOptions.CreateCopy: THelpOptions;
begin
Result:=THelpOptions.Create;
Result.Assign(Self);
end;
initialization
{$I helpoptions.lrs}
end.

107
ide/ideoptiondefs.pas
View File

@ -34,8 +34,34 @@ interface
uses
Classes, SysUtils, Laz_XMLCfg, LCLProc, Forms, Controls, StdCtrls, Buttons,
LazarusIDEStrConsts;
ConfigStorage, LazarusIDEStrConsts;
type
{ TXMLOptionsStorage }
TXMLOptionsStorage = class(TConfigStorage)
private
FXMLConfig: TXMLConfig;
protected
function GetFullPathValue(const APath, ADefault: String): String; override;
function GetFullPathValue(const APath: String; ADefault: Integer): Integer; override;
function GetFullPathValue(const APath: String; ADefault: Boolean): Boolean; override;
procedure SetFullPathValue(const APath, AValue: String); override;
procedure SetDeleteFullPathValue(const APath, AValue, DefValue: String); override;
procedure SetFullPathValue(const APath: String; AValue: Integer); override;
procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue: Integer); override;
procedure SetFullPathValue(const APath: String; AValue: Boolean); override;
procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue: Boolean); override;
procedure DeleteFullPath(const APath: string); override;
procedure DeleteFullPathValue(const APath: string); override;
public
constructor Create(TheXMLConfig: TXMLConfig);
constructor Create(TheXMLConfig: TXMLConfig; const StartPath: string);
property XMLConfig: TXMLConfig read FXMLConfig;
end;
{ non modal IDE windows }
type
TNonModalIDEWindow = (
nmiwNone, // empty/none/undefined
@ -1213,6 +1239,85 @@ begin
Items[i].SaveToXMLConfig(XMLConfig,Path+'/Dialog'+IntToStr(i+1));
end;
{ TXMLOptionsStorage }
function TXMLOptionsStorage.GetFullPathValue(const APath, ADefault: String
): String;
begin
Result:=XMLConfig.GetValue(APath, ADefault);
end;
function TXMLOptionsStorage.GetFullPathValue(const APath: String;
ADefault: Integer): Integer;
begin
Result:=XMLConfig.GetValue(APath, ADefault);
end;
function TXMLOptionsStorage.GetFullPathValue(const APath: String;
ADefault: Boolean): Boolean;
begin
Result:=XMLConfig.GetValue(APath, ADefault);
end;
procedure TXMLOptionsStorage.SetFullPathValue(const APath, AValue: String);
begin
XMLConfig.SetValue(APath, AValue);
end;
procedure TXMLOptionsStorage.SetDeleteFullPathValue(const APath, AValue,
DefValue: String);
begin
XMLConfig.SetDeleteValue(APath, AValue, DefValue);
end;
procedure TXMLOptionsStorage.SetFullPathValue(const APath: String;
AValue: Integer);
begin
XMLConfig.SetValue(APath, AValue);
end;
procedure TXMLOptionsStorage.SetDeleteFullPathValue(const APath: String;
AValue, DefValue: Integer);
begin
XMLConfig.SetDeleteValue(APath, AValue, DefValue);
end;
procedure TXMLOptionsStorage.SetFullPathValue(const APath: String;
AValue: Boolean);
begin
XMLConfig.SetValue(APath, AValue);
end;
procedure TXMLOptionsStorage.SetDeleteFullPathValue(const APath: String;
AValue, DefValue: Boolean);
begin
XMLConfig.SetDeleteValue(APath, AValue, DefValue);
end;
procedure TXMLOptionsStorage.DeleteFullPath(const APath: string);
begin
XMLConfig.DeletePath(APath);
end;
procedure TXMLOptionsStorage.DeleteFullPathValue(const APath: string);
begin
XMLConfig.DeleteValue(APath);
end;
constructor TXMLOptionsStorage.Create(TheXMLConfig: TXMLConfig);
begin
FXMLConfig:=TheXMLConfig;
if FXMLConfig=nil then
raise Exception.Create('');
end;
constructor TXMLOptionsStorage.Create(TheXMLConfig: TXMLConfig;
const StartPath: string);
begin
Create(TheXMLConfig);
AppendBasePath(StartPath);
end;
initialization
IDEDialogLayoutList:=nil;

14
ide/keymapping.pp
View File

@ -227,13 +227,15 @@ const
// help menu
ecAboutLazarus = ecUserFirst + 900;
ecOnlineHelp = ecUserFirst + 901;
ecConfigureHelp = ecUserFirst + 902;
// designer
ecCopyComponents = ecUserFirst + 1000;
ecCutComponents = ecUserFirst + 1001;
ecPasteComponents = ecUserFirst + 1002;
ecSelectParentComponent= ecUserFirst + 1003;
// custom tools
ecCustomToolFirst = ecUserFirst + 2000;
ecCustomToolLast = ecUserFirst + 2999;
@ -674,6 +676,8 @@ begin
// help menu
ecAboutLazarus: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]);
ecOnlineHelp: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]);
ecConfigureHelp: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]);
// designer
ecCopyComponents: SetResult(VK_C,[ssCtrl],VK_Insert,[ssCtrl]);
@ -1218,7 +1222,9 @@ begin
// help menu
ecAboutLazarus : Result:= lisMenuAboutLazarus;
ecOnlineHelp : Result:= lisMenuOnlineHelp;
ecConfigureHelp : Result:= lisMenuConfigureHelp;
// desginer
ecCopyComponents : Result:= lisDsgCopyComponents;
ecCutComponents : Result:= lisDsgCutComponents;
@ -2080,6 +2086,8 @@ begin
// help menu
C:=Categories[AddCategory('HelpMenu',srkmCarHelpMenu,caAll)];
AddDefault(C,'About Lazarus',ecAboutLazarus);
AddDefault(C,'Online Help',ecOnlineHelp);
AddDefault(C,'Configure Help',ecConfigureHelp);
// designer
C:=Categories[AddCategory('Designer',lisKeyCatDesigner,caDesign)];

9
ide/lazarusidestrconsts.pas
View File

@ -244,7 +244,9 @@ resourcestring
lisMenuCodeToolsDefinesEditor = 'CodeTools defines editor';
lisMenuAboutLazarus = 'About Lazarus';
lisMenuOnlineHelp = 'Online Help';
lisMenuConfigureHelp = 'Configure Help';
lisDsgCopyComponents = 'Copy selected components to clipboard';
lisDsgCutComponents = 'Cut selected components to clipboard';
lisDsgPasteComponents = 'Paste selected components from clipboard';
@ -2496,6 +2498,11 @@ resourcestring
+'compiler filename %s%s%s%sis not a valid executable.%sChoose Ok to '
+'choose the default %s%s%s.%sOtherwise check Environment -> Environment '
+'Options -> Files';
// Help Options
lisHlpOptsHelpOptions = 'Help Options';
lisHlpOptsViewers = 'Viewers';
lisHlpOptsProperties = 'Properties:';
implementation
end.

26
ide/main.pp
View File

@ -98,7 +98,7 @@ uses
PublishModule, EnvironmentOpts, TransferMacros, KeyMapping, IDEProcs,
ExtToolDialog, ExtToolEditDlg, MacroPromptDlg, OutputFilter, BuildLazDialog,
MiscOptions, InputHistory, UnitDependencies, ClipBoardHistory, ProcessList,
InitialSetupDlgs, NewDialog, MakeResStrDlg, ToDoList, AboutFrm, DialogProcs,
InitialSetupDlgs, NewDialog, MakeResStrDlg, ToDoList, DialogProcs,
FindReplaceDialog, FindInFilesDlg, CodeExplorer, BuildFileDlg, ExtractProcDlg,
DelphiUnit2Laz, CleanDirDlg,
// main ide
@ -250,8 +250,8 @@ type
// windows menu
// help menu
procedure mnuHelpAboutLazarusClicked(Sender : TObject);
// see HelpManager.pas
procedure OpenFileDownArrowClicked(Sender : TObject);
procedure mnuOpenFilePopupClick(Sender : TObject);
@ -950,6 +950,9 @@ begin
// load installed packages
PkgBoss.LoadInstalledPackages;
// load package configs
HelpBoss.LoadHelpOptions;
UpdateWindowsMenu;
@ -1700,9 +1703,6 @@ end;
procedure TMainIDE.SetupHelpMenu;
begin
inherited SetupHelpMenu;
with MainIDEBar do begin
itmHelpAboutLazarus.OnClick := @mnuHelpAboutLazarusClicked;
end;
end;
procedure TMainIDE.LoadMenuShortCuts;
@ -2059,7 +2059,7 @@ begin
mnuViewInspectorClicked(Self);
ecAboutLazarus:
mnuHelpAboutLazarusClicked(Self);
MainIDEBar.itmHelpAboutLazarus.Click;
ecAddBreakPoint:
SourceNotebook.AddBreakpointClicked(Self);
@ -2920,15 +2920,6 @@ begin
EnvironmentOptions.Save(false);
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure TMainIDE.mnuHelpAboutLazarusClicked(Sender : TObject);
begin
ShowAboutForm;
end;
//==============================================================================
function TMainIDE.CreateNewCodeBuffer(NewUnitType:TNewUnitType;
@ -10585,6 +10576,9 @@ end.
{ =============================================================================
$Log$
Revision 1.756 2004/08/21 23:16:11 mattias
implemented simple HTML help viewer
Revision 1.755 2004/08/19 18:50:53 mattias
splitted IDE component owner hierachy to reduce notification time

2
ide/mainbar.pas
View File

@ -242,6 +242,8 @@ type
// help menu
itmHelpAboutLazarus: TMenuItem;
itmHelpOnlineHelp: TMenuItem;
itmHelpConfigureHelp: TMenuItem;
// component palette
ComponentNotebook : TNotebook;

33
ide/mainbase.pas
View File

@ -695,13 +695,20 @@ begin
ParentMI:=MainIDEBar.mnuEnvironment;
with MainIDEBar do begin
CreateMenuItem(ParentMI,itmEnvGeneralOptions,'itmEnvGeneralOptions',lisMenuGeneralOptions,'menu_environmentoptions');
CreateMenuItem(ParentMI,itmEnvEditorOptions,'itmEnvEditorOptions',lisMenuEditorOptions,'menu_editoroptions');
CreateMenuItem(ParentMI,itmEnvDebuggerOptions,'itmEnvDebuggerOptions',lisMenDebuggerOptions,'');
CreateMenuItem(ParentMI,itmEnvCodeToolsOptions,'itmEnvCodeToolsOptions',lisMenuCodeToolsOptions,'menu_codetoolsoptions');
CreateMenuItem(ParentMI,itmEnvCodeToolsDefinesEditor,'itmEnvCodeToolsDefinesEditor',lisMenuCodeToolsDefinesEditor,'menu_codetoolsdefineseditor');
CreateMenuItem(ParentMI,itmEnvGeneralOptions,'itmEnvGeneralOptions',
lisMenuGeneralOptions,'menu_environmentoptions');
CreateMenuItem(ParentMI,itmEnvEditorOptions,'itmEnvEditorOptions',
lisMenuEditorOptions,'menu_editoroptions');
CreateMenuItem(ParentMI,itmEnvDebuggerOptions,'itmEnvDebuggerOptions',
lisMenDebuggerOptions,'');
CreateMenuItem(ParentMI,itmEnvCodeToolsOptions,'itmEnvCodeToolsOptions',
lisMenuCodeToolsOptions,'menu_codetoolsoptions');
CreateMenuItem(ParentMI,itmEnvCodeToolsDefinesEditor,
'itmEnvCodeToolsDefinesEditor',lisMenuCodeToolsDefinesEditor,
'menu_codetoolsdefineseditor');
ParentMI.Add(CreateMenuSeparator);
CreateMenuItem(ParentMI,itmEnvRescanFPCSrcDir,'itmEnvRescanFPCSrcDir',lisMenuRescanFPCSourceDirectory);
CreateMenuItem(ParentMI,itmEnvRescanFPCSrcDir,'itmEnvRescanFPCSrcDir',
lisMenuRescanFPCSourceDirectory);
end;
end;
@ -711,13 +718,15 @@ begin
end;
procedure TMainIDEBase.SetupHelpMenu;
var
ParentMI: TMenuItem;
begin
ParentMI:=MainIDEBar.mnuHelp;
with MainIDEBar do begin
CreateMenuItem(ParentMI,itmHelpAboutLazarus,'itmHelpAboutLazarus',lisMenuAboutLazarus);
CreateMenuItem(mnuHelp,itmHelpAboutLazarus,'itmHelpAboutLazarus',
lisMenuAboutLazarus);
CreateMenuItem(mnuHelp,itmHelpOnlineHelp,'itmHelpOnlineHelp',
lisMenuOnlineHelp);
mnuHelp.Add(CreateMenuSeparator);
CreateMenuItem(mnuHelp,itmHelpConfigureHelp,'itmHelpConfigureHelp',
lisMenuConfigureHelp);
end;
end;
@ -870,6 +879,8 @@ begin
// help menu
itmHelpAboutLazarus.ShortCut:=CommandToShortCut(ecAboutLazarus);
itmHelpOnlineHelp.ShortCut:=CommandToShortCut(ecOnlineHelp);
itmHelpConfigureHelp.ShortCut:=CommandToShortCut(ecConfigureHelp);
end;
end;

1
ideintf/Makefile.fpc
View File

@ -21,6 +21,7 @@ implicitunits=actionseditor \
columndlg \
componenteditors \
componenttreeview \
configstorage \
graphpropedits \
idecommands \
imagelisteditor \

2
ideintf/allideintf.pas
View File

@ -22,7 +22,7 @@ uses
IDECommands, PropEdits, ObjInspStrConsts, ObjectInspector, ColumnDlg,
ComponentEditors, GraphPropEdits, ListViewPropEdit, ImageListEditor,
ComponentTreeView, ActionsEditor, HelpIntf, TextTools, FormEditingIntf,
SrcEditorIntf, ComponentReg, PackageIntf, HelpHTML;
SrcEditorIntf, ComponentReg, PackageIntf, HelpHTML, ConfigStorage;
implementation

158
ideintf/configstorage.pas Normal file
View File

@ -0,0 +1,158 @@
{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Author: Mattias Gaertner
Abstract:
This unit defines various base classes for loading and saving of configs.
}
unit ConfigStorage;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
{ TConfigStorage }
TConfigStorage = class
private
FPathStack: TStrings;
FCurrentBasePath: string;
protected
function GetFullPathValue(const APath, ADefault: String): String; virtual; abstract;
function GetFullPathValue(const APath: String; ADefault: Integer): Integer; virtual; abstract;
function GetFullPathValue(const APath: String; ADefault: Boolean): Boolean; virtual; abstract;
procedure SetFullPathValue(const APath, AValue: String); virtual; abstract;
procedure SetDeleteFullPathValue(const APath, AValue, DefValue: String); virtual; abstract;
procedure SetFullPathValue(const APath: String; AValue: Integer); virtual; abstract;
procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue: Integer); virtual; abstract;
procedure SetFullPathValue(const APath: String; AValue: Boolean); virtual; abstract;
procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue: Boolean); virtual; abstract;
procedure DeleteFullPath(const APath: string); virtual; abstract;
procedure DeleteFullPathValue(const APath: string); virtual; abstract;
public
destructor Destroy; override;
function GetValue(const APath, ADefault: String): String;
function GetValue(const APath: String; ADefault: Integer): Integer;
function GetValue(const APath: String; ADefault: Boolean): Boolean;
procedure SetValue(const APath, AValue: String);
procedure SetDeleteValue(const APath, AValue, DefValue: String);
procedure SetValue(const APath: String; AValue: Integer);
procedure SetDeleteValue(const APath: String; AValue, DefValue: Integer);
procedure SetValue(const APath: String; AValue: Boolean);
procedure SetDeleteValue(const APath: String; AValue, DefValue: Boolean);
procedure DeletePath(const APath: string);
procedure DeleteValue(const APath: string);
property CurrentBasePath: string read FCurrentBasePath;
function ExtendPath(const APath: string): string;
procedure AppendBasePath(const Path: string);
procedure UndoAppendBasePath;
end;
implementation
{ TConfigStorage }
destructor TConfigStorage.Destroy;
begin
FPathStack.Free;
inherited Destroy;
end;
function TConfigStorage.GetValue(const APath, ADefault: String): String;
begin
Result:=GetFullPathValue(ExtendPath(APath),ADefault);
end;
function TConfigStorage.GetValue(const APath: String; ADefault: Integer
): Integer;
begin
Result:=GetFullPathValue(ExtendPath(APath),ADefault);
end;
function TConfigStorage.GetValue(const APath: String; ADefault: Boolean
): Boolean;
begin
Result:=GetFullPathValue(ExtendPath(APath),ADefault);
end;
procedure TConfigStorage.SetValue(const APath, AValue: String);
begin
SetFullPathValue(ExtendPath(APath),AValue);
end;
procedure TConfigStorage.SetDeleteValue(const APath, AValue, DefValue: String);
begin
SetDeleteFullPathValue(ExtendPath(APath),AValue,DefValue);
end;
procedure TConfigStorage.SetValue(const APath: String; AValue: Integer);
begin
SetFullPathValue(ExtendPath(APath),AValue);
end;
procedure TConfigStorage.SetDeleteValue(const APath: String; AValue,
DefValue: Integer);
begin
SetDeleteFullPathValue(ExtendPath(APath),AValue,DefValue);
end;
procedure TConfigStorage.SetValue(const APath: String; AValue: Boolean);
begin
SetFullPathValue(ExtendPath(APath),AValue);
end;
procedure TConfigStorage.SetDeleteValue(const APath: String; AValue,
DefValue: Boolean);
begin
SetDeleteFullPathValue(ExtendPath(APath),AValue,DefValue);
end;
procedure TConfigStorage.DeletePath(const APath: string);
begin
DeleteFullPath(ExtendPath(APath));
end;
procedure TConfigStorage.DeleteValue(const APath: string);
begin
DeleteFullPathValue(ExtendPath(APath));
end;
function TConfigStorage.ExtendPath(const APath: string): string;
begin
Result:=FCurrentBasePath+APath;
end;
procedure TConfigStorage.AppendBasePath(const Path: string);
begin
if FPathStack=nil then FPathStack:=TStringList.Create;
FPathStack.Add(FCurrentBasePath);
FCurrentBasePath:=FCurrentBasePath+Path;
if (FCurrentBasePath<>'')
and (FCurrentBasePath[length(FCurrentBasePath)]<>'/') then
FCurrentBasePath:=FCurrentBasePath+'/';
end;
procedure TConfigStorage.UndoAppendBasePath;
begin
if (FPathStack=nil) or (FPathStack.Count=0) then
raise Exception.Create('TConfigStorage.UndoAppendBasePath');
FCurrentBasePath:=FPathStack[FPathStack.Count-1];
FPathStack.Delete(FPathStack.Count-1);
end;
end.

270
ideintf/helphtml.pas
View File

@ -13,7 +13,7 @@
Author: Mattias Gaertner
Abstract:
Methods and types for HTML help.
Methods and types for simple HTML help.
}
unit HelpHTML;
@ -22,9 +22,275 @@ unit HelpHTML;
interface
uses
Classes, SysUtils, HelpIntf;
Classes, SysUtils, LCLProc, Forms, Process, FileCtrl, ConfigStorage,
PropEdits, ObjInspStrConsts, HelpIntf;
type
{ THTMLHelpDatabase }
THTMLHelpDatabase = class(THelpDatabase)
private
FBaseURL: string;
procedure SetBaseURL(const AValue: string);
public
constructor Create(TheID: THelpDatabaseID); override;
function ShowHelp(BaseNode, NewNode: THelpNode;
var ErrMsg: string): TShowHelpResult; override;
function GetEffectiveBaseURL: string;
public
property BaseURL: string read FBaseURL write SetBaseURL;
end;
{ THTMLBrowserHelpViewer }
THTMLBrowserHelpViewer = class(THelpViewer)
private
FBrowserParams: string;
FBrowserPath: string;
procedure SetBrowserParams(const AValue: string);
procedure SetBrowserPath(const AValue: string);
public
constructor Create;
function ShowNode(Node: THelpNode; var ErrMsg: string): TShowHelpResult; override;
function FindDefaultBrowser: string; virtual;
procedure Assign(Source: TPersistent); override;
procedure Load(Storage: TConfigStorage); override;
procedure Save(Storage: TConfigStorage); override;
function GetLocalizedName: string; override;
published
property BrowserPath: string read FBrowserPath write SetBrowserPath;
property BrowserParams: string read FBrowserParams write SetBrowserParams;
end;
implementation
{ THTMLHelpDatabase }
procedure THTMLHelpDatabase.SetBaseURL(const AValue: string);
begin
if FBaseURL=AValue then exit;
FBaseURL:=AValue;
end;
constructor THTMLHelpDatabase.Create(TheID: THelpDatabaseID);
begin
inherited Create(TheID);
AddSupportedMimeType('text/html');
end;
function THTMLHelpDatabase.ShowHelp(BaseNode, NewNode: THelpNode;
var ErrMsg: string): TShowHelpResult;
var
URLType, URLPath, URLParams: string;
BaseURLType, BaseURLPath, BaseURLParams: string;
Viewer: THelpViewer;
EffBaseURL: String;
Node: THelpNode;
URL: String;
begin
ErrMsg:='';
Result:=shrContextNotFound;
if NewNode.URLValid then begin
// find HTML viewer
Result:=FindViewer('text/html',ErrMsg,Viewer);
if Result<>shrSuccess then exit;
// make URL absolute
SplitURL(NewNode.URL,URLType,URLPath,URLParams);
//debugln('THTMLHelpDatabase.ShowHelp A NewNode.URL=',NewNode.URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);
if URLType='file' then begin
if not URLFilenameIsAbsolute(URLPath) then begin
EffBaseURL:=GetEffectiveBaseURL;
SplitURL(EffBaseURL,BaseURLType,BaseURLPath,BaseURLParams);
if (BaseURLType='file') and (BaseURLPath<>'') then
URLPath:=BaseURLPath+URLPath;
end;
if (not FileExists(URLPath)) then begin
Result:=shrContextNotFound;
ErrMsg:=Format(oisHelpTheHelpDatabaseWasUnableToFindFile, ['"', ID,
'"', '"', URLPath, '"']);
exit;
end;
end else begin
end;
URL:=CombineURL(URLType,URLPath,URLParams);
//debugln('THTMLHelpDatabase.ShowHelp B URL=',URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);
// call viewer
Node:=THelpNode.Create(Self,NewNode);
try
Node.URL:=URL;
Result:=Viewer.ShowNode(Node,ErrMsg);
finally
Node.Free;
end;
end else begin
Result:=shrContextNotFound;
ErrMsg:='THTMLHelpDatabase.ShowHelp Node.URLValid=false';
end;
end;
function THTMLHelpDatabase.GetEffectiveBaseURL: string;
begin
Result:='';
if BaseURL<>'' then
Result:=BaseURL
else if (BasePathObject<>nil) and (Databases<>nil) then
Result:=Databases.GetBaseURLForBasePathObject(BasePathObject);
if (Result<>'') and (Result[length(Result)]<>'/') then
Result:=Result+'/';
end;
{ THTMLBrowserHelpViewer }
procedure THTMLBrowserHelpViewer.SetBrowserParams(const AValue: string);
begin
if FBrowserParams=AValue then exit;
FBrowserParams:=AValue;
end;
procedure THTMLBrowserHelpViewer.SetBrowserPath(const AValue: string);
begin
if FBrowserPath=AValue then exit;
FBrowserPath:=AValue;
end;
constructor THTMLBrowserHelpViewer.Create;
begin
inherited Create;
AddSupportedMimeType('text/html');
FBrowserParams:='%s';
ParameterHelp:=oisHelpTheMacroSInBrowserParamsWillBeReplacedByTheURL;
end;
function THTMLBrowserHelpViewer.ShowNode(Node: THelpNode; var ErrMsg: string
): TShowHelpResult;
var
Params: String;
URLMacroPos: LongInt;
BrowserProcess: TProcess;
CommandLine: String;
begin
Result:=shrViewerError;
ErrMsg:='';
if (not Node.URLValid) then begin
ErrMsg:='THTMLBrowserHelpViewer.ShowNode Node.URLValid=false';
exit;
end;
if (Node.URL='') then begin
ErrMsg:='THTMLBrowserHelpViewer.ShowNode Node.URL empty';
exit;
end;
// check browser path
CommandLine:=BrowserPath;
if CommandLine='' then
CommandLine:=FindDefaultBrowser;
if CommandLine='' then begin
ErrMsg:=Format(oisHelpNoHTMLBrowserFoundPleaseDefineOneInHelpConfigureHe, [
#13]);
exit;
end;
if (not FileExists(CommandLine)) then begin
ErrMsg:=Format(oisHelpBrowserNotFound, ['"', CommandLine, '"']);
exit;
end;
if (not FileIsExecutable(CommandLine)) then begin
ErrMsg:=Format(oisHelpBrowserNotExecutable, ['"', CommandLine, '"']);
exit;
end;
//debugln('THTMLBrowserHelpViewer.ShowNode Node.URL=',Node.URL);
// create params and replace %s for URL
Params:=BrowserParams;
URLMacroPos:=Pos('%s',Params);
if URLMacroPos>=1 then
Params:=copy(Params,1,URLMacroPos-1)+Node.URL
+copy(Params,URLMacroPos+2,length(Params)-URLMacroPos-1)
else begin
if Params<>'' then
Params:=Params+' ';
Params:=Params+Node.URL;
end;
CommandLine:=CommandLine+' '+Params;
// run
try
BrowserProcess:=TProcess.Create(nil);
try
BrowserProcess.CommandLine:=CommandLine;
BrowserProcess.Execute;
finally
BrowserProcess.Free;
end;
Result:=shrSuccess;
except
on E: Exception do begin
ErrMsg:=Format(oisHelpErrorWhileExecuting, ['"', CommandLine, '"', #13,
E.Message]);
end;
end;
end;
function THTMLBrowserHelpViewer.FindDefaultBrowser: string;
function Find(const ShortFilename: string; var Filename: string): boolean;
begin
Filename:=SearchFileInPath(ShortFilename{$IFDEF win32}+'.exe'{$ENDIF},'',
Application.EnvironmentVariable['PATH'],':',[]);
Result:=Filename<>'';
end;
begin
Result:='';
// prefer open source ;)
if Find('mozilla',Result) then exit;
if Find('galeon',Result) then exit;
if Find('konqueror',Result) then exit;
if Find('safari',Result) then exit;
if Find('netscape',Result) then exit;
if Find('opera',Result) then exit;
if Find('iexplorer',Result) then exit;
Result:='';
end;
procedure THTMLBrowserHelpViewer.Assign(Source: TPersistent);
var
Viewer: THTMLBrowserHelpViewer;
begin
if Source is THTMLBrowserHelpViewer then begin
Viewer:=THTMLBrowserHelpViewer(Source);
BrowserPath:=Viewer.BrowserPath;
BrowserParams:=Viewer.BrowserParams;
end;
inherited Assign(Source);
end;
procedure THTMLBrowserHelpViewer.Load(Storage: TConfigStorage);
begin
BrowserPath:=Storage.GetValue('Browser/Path','');
BrowserParams:=Storage.GetValue('Browser/Params','');
end;
procedure THTMLBrowserHelpViewer.Save(Storage: TConfigStorage);
begin
Storage.SetDeleteValue('Browser/Path',BrowserPath,'');
Storage.SetDeleteValue('Browser/Params',BrowserParams,'%s');
end;
function THTMLBrowserHelpViewer.GetLocalizedName: string;
begin
Result:='HTML Browser';
end;
initialization
RegisterPropertyEditor(TypeInfo(AnsiString),
THTMLBrowserHelpViewer,'BrowserPath',TFileNamePropertyEditor);
end.

581
ideintf/helpintf.pas
View File

@ -22,7 +22,7 @@ unit HelpIntf;
interface
uses
Classes, SysUtils, Controls;
Classes, SysUtils, Controls, FileCtrl, ConfigStorage;
type
// All help-specific error messages should be thrown as this type.
@ -66,52 +66,70 @@ type
For example it points to Help file or to a Link on a HTML file. }
THelpNodeType = (
hntFile, // Filename valid, ignore Link and ID
hntFileLink, // Filename and Link valid, ignore ID
hntFileID // Filename and ID valid, ignore Link
hntURLIDContext, // URL, ID and Context valid
hntURL, // URL valid, ignore ID and Context
hntURLID, // URL and ID valid, ignore Context
hntID, // ID valid, ignore URL and Context
hntContext, // Context valid, ignore URL and ID
hntURLContext // URL and Context valid, ignore ID
);
THelpNode = class(TPersistent)
private
FFilename: string;
FContext: THelpContext;
FURL: string;
FHelpType: THelpNodeType;
fID: integer;
FLink: string;
fID: string;
FOwner: THelpDatabase;
FTitle: string;
public
constructor Create(TheOwner: THelpDatabase; Node: THelpNode);
constructor Create(TheOwner: THelpDatabase;
const TheTitle, TheFilename: string);
constructor Create(TheOwner: THelpDatabase; const TheTitle, TheFilename,
TheLink: string);
constructor Create(TheOwner: THelpDatabase; const TheTitle,
TheFilename: string; TheID: integer);
const TheTitle, TheURL, TheID: string;
TheContext: THelpContext);
constructor CreateURL(TheOwner: THelpDatabase;
const TheTitle, TheURL: string);
constructor CreateID(TheOwner: THelpDatabase; const TheTitle, TheID: string);
constructor CreateURLID(TheOwner: THelpDatabase; const TheTitle,
TheURL, TheID: string);
constructor CreateContext(TheOwner: THelpDatabase; const TheTitle: string;
TheContext: THelpContext);
constructor CreateURLContext(TheOwner: THelpDatabase;
const TheTitle, TheURL: string;
TheContext: THelpContext);
public
property Owner: THelpDatabase read FOwner write FOwner;
function URLValid: boolean;
function IDValid: boolean;
function ContextValid: boolean;
procedure Assign(Source: TPersistent); override;
published
property Title: string read FTitle write FTitle;
property HelpType: THelpNodeType read FHelpType write FHelpType;
property Filename: string read FFilename write FFilename;
property ID: integer read fID write fID;
property Link: string read FLink write FLink;
property URL: string read FURL write FURL;
property ID: string read fID write fID;
property Context: THelpContext read FContext write FContext;
end;
{ THelpDBSearchItem
Base class for registered search items associated with a THelpDatabase.
Base class for registration search items associated with a THelpDatabase.
See THelpDBSISourceDirectory for an example.
Node is optional, pointing to a help page about the help item. }
THelpDBSearchItem = class(TPersistent)
private
FNode: THelpNode;
public
constructor Create(TheNode: THelpNode);
destructor Destroy; override;
published
property Node: THelpNode read FNode write FNode;
end;
{ THelpDBSISourceFile
Used by the IDE to search for help for a sourcefile
Help registration item for a single source file.
If Filename is relative, the BasePathObject is used to get a base directory.
For example: If BasePathObject is a TLazPackage the Filename is relative to
@ -128,6 +146,7 @@ type
{ THelpDBSISourceDirectory
Help registration item for a source directory.
As THelpDBSISourceFile, except that Filename is a directory and
the item is valid for all source files fitting the FileMask.
FileMask can be for example '*.pp;*.pas;*.inc'
@ -148,6 +167,7 @@ type
{ THelpDBSIClass
Help registration item for a class.
Used by the IDE to search for help for a class without source.
For example for a registered component class in the component palette, that
comes without source. If the component comes with source use the
@ -168,6 +188,7 @@ type
THelpDatabaseID = string;
THelpDatabases = class;
THelpViewer = class;
THelpDatabase = class(TPersistent)
private
@ -177,10 +198,14 @@ type
FRefCount: integer;
FSearchItems: TList;
FSupportedMimeTypes: TStrings;
FTOCNode: THelpNode;
procedure SetID(const AValue: THelpDatabaseID);
procedure SetDatabases(const AValue: THelpDatabases);
protected
procedure SetSupportedMimeTypes(List: TStrings); virtual;
procedure AddSupportedMimeType(const AMimeType: string); virtual;
public
constructor Create(TheID: THelpDatabaseID);
constructor Create(TheID: THelpDatabaseID); virtual;
destructor Destroy; override;
procedure Reference;
procedure RegisterSelf;
@ -189,8 +214,11 @@ type
function Registered: boolean;
function CanShowTableOfContents: boolean; virtual;
procedure ShowTableOfContents; virtual;
procedure ShowError(ShowResult: TShowHelpResult; const ErrMsg: string); virtual;
function ShowHelp(BaseNode, NewNode: THelpNode;
var ErrMsg: string): TShowHelpResult;
var ErrMsg: string): TShowHelpResult; virtual;
function ShowHelpFile(BaseNode: THelpNode; const Title, Filename: string;
var ErrMsg: string): TShowHelpResult; virtual;
function SupportsMimeType(const AMimeType: string): boolean; virtual;
function GetNodesForKeyword(const HelpKeyword: string;
var ListOfNodes: TList; var ErrMsg: string
@ -198,9 +226,12 @@ type
function GetNodesForContext(HelpContext: THelpContext;
var ListOfNodes: TList; var ErrMsg: string
): TShowHelpResult; virtual;
function FindViewer(const MimeType: string; var ErrMsg: string;
var Viewer: THelpViewer): TShowHelpResult; virtual;
public
// registration
procedure RegisterItem(NewItem: THelpDBSearchItem);
procedure RegisterItemWithNode(Node: THelpNode);
procedure UnregisterItem(AnItem: THelpDBSearchItem);
function RegisteredItemCount: integer;
function GetRegisteredItem(Index: integer): THelpDBSearchItem;
@ -209,6 +240,7 @@ type
property ID: THelpDatabaseID read FID write SetID;
property SupportedMimeTypes: TStrings read FSupportedMimeTypes;
property BasePathObject: TObject read FBasePathObject write FBasePathObject;
property TOCNode: THelpNode read FTOCNode write FTOCNode;
end;
THelpDatabaseClass = class of THelpDatabase;
@ -229,12 +261,15 @@ type
function Count: integer;
property Items[Index: integer]: THelpDatabase read GetItems; default;
public
// find databases
function FindDatabase(ID: THelpDatabaseID): THelpDatabase;
function IndexOf(ID: THelpDatabaseID): integer;
public
// table of content
function CreateUniqueDatabaseID(const WishID: string): THelpDatabaseID;
function CreateHelpDatabase(const WishID: string;
HelpDataBaseClass: THelpDatabaseClass;
AutoRegister: boolean): THelpDatabase;
function ShowTableOfContents(var ErrMsg: string): TShowHelpResult;
procedure ShowError(ShowResult: TShowHelpResult; const ErrMsg: string); virtual; abstract;
function GetBaseURLForBasePathObject(BasePathObject: TObject): string; virtual;
public
// show help for ...
function ShowHelpForNodes(Nodes: TList; var ErrMsg: string): TShowHelpResult;
@ -272,21 +307,28 @@ type
THelpViewer = class(TPersistent)
private
FPreferredLanguage: string;
procedure SetPreferredLanguage(const AValue: string);
protected
FParameterHelp: string;
FStorageName: string;
FSupportedMimeTypes: TStrings;
protected
procedure SetSupportedMimeTypes(List: TStrings); virtual;
procedure AddSupportedMimeType(const AMimeType: string); virtual;
public
constructor Create;
destructor Destroy; override;
function SupportsTableOfContents: boolean; virtual;
procedure ShowTableOfContents(Node: THelpNode); virtual;
function SupportsMimeType(const AMimeType: string): boolean; virtual;
procedure ShowNode(Node: THelpNode); virtual;
function ShowNode(Node: THelpNode; var ErrMsg: string): TShowHelpResult; virtual;
procedure Hide; virtual;
procedure Assign(Source: TPersistent); override;
procedure Load(Storage: TConfigStorage); virtual;
procedure Save(Storage: TConfigStorage); virtual;
function GetLocalizedName: string; virtual;
public
property SupportedMimeTypes: TStrings read FSupportedMimeTypes;
property PreferredLanguage: string read FPreferredLanguage
write SetPreferredLanguage;
property ParameterHelp: string read FParameterHelp write FParameterHelp;
property StorageName: string read FStorageName write FStorageName;
end;
THelpViewerClass = class of THelpViewer;
@ -303,11 +345,13 @@ type
destructor Destroy; override;
procedure Clear;
function Count: integer;
function GetHelpViewers(const MimeType: string): TList;
function GetViewersSupportingMimeType(const MimeType: string): TList;
procedure RegisterViewer(AHelpViewer: THelpViewer);
procedure UnregisterViewer(AHelpViewer: THelpViewer);
procedure Load(Storage: TConfigStorage); virtual;
procedure Save(Storage: TConfigStorage); virtual;
public
property Items[Index: integer]: THelpViewer read GetItems;
property Items[Index: integer]: THelpViewer read GetItems; default;
end;
@ -326,15 +370,20 @@ var
}
// table of contents
function ShowTableOfContents: TShowHelpResult;
function ShowTableOfContents(var ErrMsg: string): TShowHelpResult;
// help by ID
function ShowHelpOrErrorForContext(HelpDatabaseID: THelpDatabaseID;
HelpContext: THelpContext): TShowHelpResult;
function ShowHelpForContext(HelpDatabaseID: THelpDatabaseID;
HelpContext: THelpContext; var ErrMsg: string): TShowHelpResult;
function ShowHelpForContext(HelpContext: THelpContext; var ErrMsg: string
): TShowHelpResult;
// help by keyword
function ShowHelpOrErrorForKeyword(HelpDatabaseID: THelpDatabaseID;
const HelpKeyword: string): TShowHelpResult;
function ShowHelpForKeyword(HelpDatabaseID: THelpDatabaseID;
const HelpKeyword: string; var ErrMsg: string): TShowHelpResult;
function ShowHelpForKeyword(const HelpKeyword: string; var ErrMsg: string
@ -348,15 +397,38 @@ function ShowHelpForPascalSource(ContextList: TPascalHelpContextPtr;
function ShowHelpForMessageLine(const MessageLine: string;
var ErrMsg: string): TShowHelpResult;
// URL functions
function FilenameToURL(const Filename: string): string;
procedure SplitURL(const URL: string; var URLType, URLPath, URLParams: string);
function CombineURL(const URLType, URLPath, URLParams: string): string;
function URLFilenameIsAbsolute(const Filename: string): boolean;
implementation
function ShowTableOfContents: TShowHelpResult;
var
ErrMsg: String;
begin
ErrMsg:='';
Result:=ShowTableOfContents(ErrMsg);
HelpDatabases.ShowError(Result,ErrMsg);
end;
function ShowTableOfContents(var ErrMsg: string): TShowHelpResult;
begin
Result:=HelpDatabases.ShowTableOfContents(ErrMsg);
end;
function ShowHelpOrErrorForContext(HelpDatabaseID: THelpDatabaseID;
HelpContext: THelpContext): TShowHelpResult;
var
ErrMsg: String;
begin
ErrMsg:='';
Result:=ShowHelpForContext(HelpDatabaseID,HelpContext,ErrMsg);
HelpDatabases.ShowError(Result,ErrMsg);
end;
function ShowHelpForContext(HelpDatabaseID: THelpDatabaseID;
HelpContext: THelpContext; var ErrMsg: string): TShowHelpResult;
begin
@ -369,6 +441,16 @@ begin
Result:=ShowHelpForContext('',HelpContext,ErrMsg);
end;
function ShowHelpOrErrorForKeyword(HelpDatabaseID: THelpDatabaseID;
const HelpKeyword: string): TShowHelpResult;
var
ErrMsg: String;
begin
ErrMsg:='';
Result:=ShowHelpForKeyword(HelpDatabaseID,HelpKeyword,ErrMsg);
HelpDatabases.ShowError(Result,ErrMsg);
end;
function ShowHelpForKeyword(HelpDatabaseID: THelpDatabaseID;
const HelpKeyword: string; var ErrMsg: string): TShowHelpResult;
begin
@ -393,6 +475,72 @@ begin
Result:=HelpDatabases.ShowHelpForMessageLine(MessageLine,ErrMsg);
end;
function FilenameToURL(const Filename: string): string;
var
i: Integer;
begin
Result:=Filename;
if PathDelim<>'/' then
for i:=1 to length(Result) do
if Result[i]=PathDelim then
Result[i]:='/';
if Result<>'' then
Result:='file://'+Result;
end;
procedure SplitURL(const URL: string; var URLType, URLPath, URLParams: string);
var
Len: Integer;
ColonPos: Integer;
ParamStartPos: integer;
URLStartPos: Integer;
begin
URLType:='';
URLPath:='';
URLParams:='';
Len:=length(URL);
// search color
ColonPos:=1;
while (ColonPos<=len) and (URL[ColonPos]<>':') do
inc(ColonPos);
if ColonPos=len then exit;
// get URLType
URLType:=copy(URL,1,ColonPos-1);
URLStartPos:=ColonPos+1;
// skip the '//' after the colon
if (URLStartPos<=len) and (URL[URLStartPos]='/') then inc(URLStartPos);
if (URLStartPos<=len) and (URL[URLStartPos]='/') then inc(URLStartPos);
// search param delimiter ?
ParamStartPos:=ColonPos+1;
while (ParamStartPos<=len) and (URL[ParamStartPos]<>'?') do
inc(ParamStartPos);
// get URLPath and URLParams
URLPath:=copy(URL,URLStartPos,ParamStartPos-URLStartPos);
URLParams:=copy(URL,ParamStartPos+1,len-ParamStartPos);
end;
function CombineURL(const URLType, URLPath, URLParams: string): string;
begin
Result:=URLType+'://'+URLPath;
if URLParams<>'' then
Result:=Result+'?'+URLParams;
end;
function URLFilenameIsAbsolute(const Filename: string): boolean;
begin
if PathDelim='/' then
Result:=FilenameIsAbsolute(Filename)
else
Result:=FilenameIsAbsolute(SetDirSeparators(Filename));
end;
procedure CreateListAndAdd(const AnObject: TObject; var List: TList);
begin
if List=nil then List:=TList.Create;
List.Add(AnObject);
end;
{ THelpDatabase }
procedure THelpDatabase.SetID(const AValue: THelpDatabaseID);
@ -409,9 +557,23 @@ end;
procedure THelpDatabase.SetDatabases(const AValue: THelpDatabases);
begin
if AValue=Databases then exit;
Reference;
if FDatabases<>nil then FDatabases.DoUnregisterDatabase(Self);
FDatabases:=AValue;
if FDatabases<>nil then FDatabases.DoRegisterDatabase(Self);
Release;
end;
procedure THelpDatabase.SetSupportedMimeTypes(List: TStrings);
begin
FSupportedMimeTypes.Free;
FSupportedMimeTypes:=List;
end;
procedure THelpDatabase.AddSupportedMimeType(const AMimeType: string);
begin
if FSupportedMimeTypes=nil then SetSupportedMimeTypes(TStringList.Create);
FSupportedMimeTypes.Add(AMimeType);
end;
constructor THelpDatabase.Create(TheID: THelpDatabaseID);
@ -420,10 +582,18 @@ begin
end;
destructor THelpDatabase.Destroy;
var
i: Integer;
begin
Reference; // reference to not call Free again
if Databases<>nil then UnregisterSelf;
FSupportedMimeTypes.Free;
FSearchItems.Free;
if FSearchItems<>nil then begin
for i:=FSearchItems.Count-1 downto 0 do
THelpNode(FSearchItems[i]).Free;
FSearchItems.Free;
end;
FTOCNode.Free;
inherited Destroy;
end;
@ -448,12 +618,28 @@ end;
function THelpDatabase.CanShowTableOfContents: boolean;
begin
Result:=false;
Result:=TOCNode<>nil;
end;
procedure THelpDatabase.ShowTableOfContents;
var
ErrMsg: string;
ShowResult: TShowHelpResult;
begin
// for descendents to override
if TOCNode=nil then exit;
ErrMsg:='';
ShowResult:=ShowHelp(nil,TOCNode,ErrMsg);
ShowError(ShowResult,ErrMsg);
end;
procedure THelpDatabase.ShowError(ShowResult: TShowHelpResult;
const ErrMsg: string);
begin
if ShowResult=shrSuccess then exit;
if Databases<>nil then
Databases.ShowError(ShowResult,ErrMsg)
else
raise EHelpSystemException.Create(ErrMsg);
end;
function THelpDatabase.ShowHelp(BaseNode, NewNode: THelpNode; var ErrMsg: string
@ -463,6 +649,19 @@ begin
Result:=shrContextNotFound;
end;
function THelpDatabase.ShowHelpFile(BaseNode: THelpNode;
const Title, Filename: string; var ErrMsg: string): TShowHelpResult;
var
FileNode: THelpNode;
begin
FileNode:=THelpNode.CreateURL(Self,Title,FilenameToURL(Filename));
try
Result:=ShowHelp(BaseNode,FileNode,ErrMsg);
finally
FileNode.Free;
end;
end;
function THelpDatabase.SupportsMimeType(const AMimeType: string): boolean;
begin
Result:=false;
@ -474,25 +673,80 @@ function THelpDatabase.GetNodesForKeyword(const HelpKeyword: string;
var ListOfNodes: TList; var ErrMsg: string): TShowHelpResult;
// if ListOfNodes<>nil new nodes will be appended
// if ListOfNodes=nil and nodes exists a new list will be created
var
i: Integer;
Node: THelpNode;
begin
Result:=shrSuccess;
ErrMsg:='';
// add the registered nodes
if FSearchItems<>nil then begin
for i:=0 to FSearchItems.Count-1 do begin
Node:=THelpDBSearchItem(FSearchItems[i]).Node;
if (Node=nil) or (not Node.IDValid) then continue;
if AnsiCompareText(Node.ID,HelpKeyword)<>0 then continue;
CreateListAndAdd(Node, ListOfNodes);
end;
end;
end;
function THelpDatabase.GetNodesForContext(HelpContext: THelpContext;
var ListOfNodes: TList; var ErrMsg: string): TShowHelpResult;
// if ListOfNodes<>nil new nodes will be appended
// if ListOfNodes=nil and nodes exists a new list will be created
var
i: Integer;
Node: THelpNode;
begin
Result:=shrSuccess;
ErrMsg:='';
// add the registered nodes
if FSearchItems<>nil then begin
for i:=0 to FSearchItems.COunt-1 do begin
Node:=THelpDBSearchItem(FSearchItems[i]).Node;
if (Node=nil) or (not Node.ContextValid) then continue;
if Node.Context<>HelpContext then continue;
CreateListAndAdd(Node, ListOfNodes);
end;
end;
end;
function THelpDatabase.FindViewer(const MimeType: string; var ErrMsg: string;
var Viewer: THelpViewer): TShowHelpResult;
var
Viewers: TList;
begin
Viewer:=nil;
Viewers:=HelpViewers.GetViewersSupportingMimeType(MimeType);
try
if (Viewers=nil) or (Viewers.Count=0) then begin
ErrMsg:='Help Database "'+ID+'" did not found a viewer for a help page of type '+MimeType;
Result:=shrViewerNotFound;
end else begin
Viewer:=THelpViewer(Viewers[0]);
Result:=shrSuccess;
end;
finally
Viewers.Free;
end;
end;
procedure THelpDatabase.RegisterItem(NewItem: THelpDBSearchItem);
begin
if NewItem=nil then
raise EHelpSystemException.Create('THelpDatabase.RegisterItem NewItem=nil');
if FSearchItems=nil then FSearchItems:=TList.Create;
if FSearchItems.IndexOf(NewItem)<0 then
FSearchItems.Add(NewItem);
FSearchItems.Add(NewItem)
else
NewItem.Free;
end;
procedure THelpDatabase.RegisterItemWithNode(Node: THelpNode);
begin
if Node=nil then
raise EHelpSystemException.Create('THelpDatabase.RegisterItemWithNode Node=nil');
RegisterItem(THelpDBSearchItem.Create(Node));
end;
procedure THelpDatabase.UnregisterItem(AnItem: THelpDBSearchItem);
@ -587,6 +841,30 @@ begin
dec(Result);
end;
function THelpDatabases.CreateUniqueDatabaseID(
const WishID: string): THelpDatabaseID;
var
i: Integer;
begin
if (WishID<>'') and (FindDatabase(WishID)=nil) then begin
Result:=WishID;
end else begin
i:=1;
repeat
Result:=WishID+IntToStr(i);
if FindDatabase(Result)=nil then exit;
inc(i);
until false;
end;
end;
function THelpDatabases.CreateHelpDatabase(const WishID: string;
HelpDataBaseClass: THelpDatabaseClass; AutoRegister: boolean): THelpDatabase;
begin
Result:=HelpDataBaseClass.Create(CreateUniqueDatabaseID(WishID));
if AutoRegister then Result.RegisterSelf;
end;
function THelpDatabases.ShowTableOfContents(var ErrMsg: string
): TShowHelpResult;
begin
@ -595,6 +873,12 @@ begin
// ToDo
end;
function THelpDatabases.GetBaseURLForBasePathObject(BasePathObject: TObject
): string;
begin
Result:='';
end;
function THelpDatabases.ShowHelpForNodes(Nodes: TList; var ErrMsg: string
): TShowHelpResult;
var
@ -602,6 +886,7 @@ var
begin
// check if several nodes found
if (Nodes.Count>1) then begin
Node:=nil;
Result:=ShowHelpSelector(Nodes,ErrMsg,Node);
if Result<>shrSuccess then exit;
if Node=nil then exit;
@ -612,7 +897,7 @@ begin
// show node
if Node.Owner=nil then begin
Result:=shrDatabaseNotFound;
ErrMsg:='Help node not found';
ErrMsg:='Help node has no Help Database';
exit;
end;
Result:=Node.Owner.ShowHelp(nil,Node,ErrMsg);
@ -624,6 +909,7 @@ var
Nodes: TList;
HelpDB: THelpDatabase;
begin
ErrMsg:='';
Result:=shrHelpNotFound;
// search node
@ -633,6 +919,7 @@ begin
HelpDB:=FindDatabase(HelpDatabaseID);
if HelpDB=nil then begin
Result:=shrDatabaseNotFound;
ErrMsg:='Help Database "'+HelpDatabaseID+'" not found';
exit;
end;
Result:=HelpDB.GetNodesForContext(HelpContext,Nodes,ErrMsg);
@ -646,7 +933,11 @@ begin
if (Nodes<>nil) then Nodes.Pack;
if (Nodes=nil) or (Nodes.Count=0) then begin
Result:=shrContextNotFound;
ErrMsg:='Help context '+IntToStr(HelpContext)+' not found.';
if HelpDatabaseID<>'' then
ErrMsg:='Help context '+IntToStr(HelpContext)+' not found'
+' in Database "'+HelpDatabaseID+'".'
else
ErrMsg:='Help context '+IntToStr(HelpContext)+' not found.';
exit;
end;
@ -662,6 +953,7 @@ var
Nodes: TList;
HelpDB: THelpDatabase;
begin
ErrMsg:='';
Result:=shrHelpNotFound;
// search node
@ -671,6 +963,7 @@ begin
HelpDB:=FindDatabase(HelpDatabaseID);
if HelpDB=nil then begin
Result:=shrDatabaseNotFound;
ErrMsg:='Help Database "'+HelpDatabaseID+'" not found';
exit;
end;
Result:=HelpDB.GetNodesForKeyword(HelpKeyword,Nodes,ErrMsg);
@ -684,7 +977,11 @@ begin
if (Nodes<>nil) then Nodes.Pack;
if (Nodes=nil) or (Nodes.Count=0) then begin
Result:=shrContextNotFound;
ErrMsg:='Help keyword '+HelpKeyword+' not found.';
if HelpDatabaseID<>'' then
ErrMsg:='Help keyword "'+HelpKeyword+'" not found'
+' in Database "'+HelpDatabaseID+'".'
else
ErrMsg:='Help keyword "'+HelpKeyword+'" not found.';
exit;
end;
@ -698,24 +995,24 @@ function THelpDatabases.ShowHelpForPascalSource(
ContextList: TPascalHelpContextPtr; var ErrMsg: string): TShowHelpResult;
begin
Result:=shrHelpNotFound;
ErrMsg:='THelpDatabases.ShowHelpForPascalSource not implemented yet';
// ToDo
ErrMsg:='THelpDatabases.ShowHelpForPascalSource not implemented yet';
end;
function THelpDatabases.ShowHelpForMessageLine(const MessageLine: string;
var ErrMsg: string): TShowHelpResult;
begin
Result:=shrHelpNotFound;
ErrMsg:='THelpDatabases.ShowHelpForMessageLine not implemented yet';
// ToDo
ErrMsg:='THelpDatabases.ShowHelpForMessageLine not implemented yet';
end;
function THelpDatabases.ShowHelpForClass(const AClass: TClass;
var ErrMsg: string): TShowHelpResult;
begin
Result:=shrHelpNotFound;
ErrMsg:='THelpDatabases.ShowHelpForClass not implemented yet';
// ToDo
ErrMsg:='THelpDatabases.ShowHelpForClass not implemented yet';
end;
function THelpDatabases.GetNodesForKeyword(const HelpKeyword: string;
@ -726,6 +1023,7 @@ var
i: Integer;
begin
Result:=shrSuccess;
ErrMsg:='';
for i:=Count-1 downto 0 do begin
Result:=Items[i].GetNodesForKeyword(HelpKeyword,ListOfNodes,ErrMsg);
if Result<>shrSuccess then exit;
@ -740,6 +1038,7 @@ var
i: Integer;
begin
Result:=shrSuccess;
ErrMsg:='';
for i:=Count-1 downto 0 do begin
Result:=Items[i].GetNodesForContext(HelpContext,ListOfNodes,ErrMsg);
if Result<>shrSuccess then exit;
@ -804,8 +1103,10 @@ begin
end;
procedure THelpViewers.Clear;
var
i: Integer;
begin
while (Count>0) do Items[Count-1].Free;
for i:=0 to Count-1 do Items[Count-1].Free;
FItems.Clear;
end;
@ -814,7 +1115,8 @@ begin
Result:=FItems.Count;
end;
function THelpViewers.GetHelpViewers(const MimeType: string): TList;
function THelpViewers.GetViewersSupportingMimeType(
const MimeType: string): TList;
var
i: Integer;
begin
@ -837,12 +1139,55 @@ begin
FItems.Remove(AHelpViewer);
end;
procedure THelpViewers.Load(Storage: TConfigStorage);
var
i: Integer;
Viewer: THelpViewer;
begin
for i:=0 to Count-1 do begin
Viewer:=Items[i];
Storage.AppendBasePath(Viewer.StorageName);
try
Viewer.Load(Storage);
finally
Storage.UndoAppendBasePath;
end;
end;
end;
procedure THelpViewers.Save(Storage: TConfigStorage);
var
i: Integer;
Viewer: THelpViewer;
begin
for i:=0 to Count-1 do begin
Viewer:=Items[i];
Storage.AppendBasePath(Viewer.StorageName);
try
Viewer.Save(Storage);
finally
Storage.UndoAppendBasePath;
end;
end;
end;
{ THelpViewer }
procedure THelpViewer.SetPreferredLanguage(const AValue: string);
procedure THelpViewer.SetSupportedMimeTypes(List: TStrings);
begin
if FPreferredLanguage=AValue then exit;
FPreferredLanguage:=AValue;
if FSupportedMimeTypes<>nil then FSupportedMimeTypes.Free;
FSupportedMimeTypes:=nil;
end;
procedure THelpViewer.AddSupportedMimeType(const AMimeType: string);
begin
if FSupportedMimeTypes=nil then FSupportedMimeTypes:=TStringList.Create;
FSupportedMimeTypes.Add(AMimeType);
end;
constructor THelpViewer.Create;
begin
FStorageName:=ClassName;
end;
destructor THelpViewer.Destroy;
@ -858,7 +1203,7 @@ end;
procedure THelpViewer.ShowTableOfContents(Node: THelpNode);
begin
// ToDo
raise EHelpSystemException.Create('THelpViewer.ShowTableOfContents not implemented');
end;
function THelpViewer.SupportsMimeType(const AMimeType: string): boolean;
@ -868,9 +1213,12 @@ begin
Result:=(FSupportedMimeTypes.IndexOf(AMimeType)>=0);
end;
procedure THelpViewer.ShowNode(Node: THelpNode);
function THelpViewer.ShowNode(Node: THelpNode; var ErrMsg: string
): TShowHelpResult;
begin
// ToDo
// for descendents to override
Result:=shrViewerError;
ErrMsg:='THelpViewer.ShowNode not implemented for this help type';
end;
procedure THelpViewer.Hide;
@ -878,32 +1226,135 @@ begin
// override this
end;
procedure THelpViewer.Assign(Source: TPersistent);
begin
if Source is THelpViewer then begin
end;
inherited Assign(Source);
end;
procedure THelpViewer.Load(Storage: TConfigStorage);
begin
end;
procedure THelpViewer.Save(Storage: TConfigStorage);
begin
end;
function THelpViewer.GetLocalizedName: string;
begin
Result:=StorageName;
end;
{ THelpNode }
constructor THelpNode.Create(TheOwner: THelpDatabase; const TheTitle,
TheFilename: string);
constructor THelpNode.Create(TheOwner: THelpDatabase; Node: THelpNode);
begin
FHelpType:=hntFile;
FTitle:=TheTitle;
FFilename:=TheFilename;
FOwner:=TheOwner;
Assign(Node);
end;
constructor THelpNode.Create(TheOwner: THelpDatabase; const TheTitle,
TheFilename, TheLink: string);
TheURL, TheID: string; TheContext: THelpContext);
begin
FHelpType:=hntFileLink;
FOwner:=TheOwner;
FHelpType:=hntURLIDContext;
FTitle:=TheTitle;
FFilename:=TheFilename;
FLink:=TheLink;
end;
constructor THelpNode.Create(TheOwner: THelpDatabase;
const TheTitle, TheFilename: string; TheID: integer);
begin
FHelpType:=hntFileID;
FTitle:=TheTitle;
FFilename:=TheFilename;
FURL:=TheURL;
FID:=TheID;
FContext:=TheContext;
end;
constructor THelpNode.CreateURL(TheOwner: THelpDatabase; const TheTitle,
TheURL: string);
begin
FOwner:=TheOwner;
FHelpType:=hntURL;
FTitle:=TheTitle;
FURL:=TheURL;
end;
constructor THelpNode.CreateID(TheOwner: THelpDatabase;
const TheTitle, TheID: string);
begin
FOwner:=TheOwner;
FHelpType:=hntID;
FTitle:=TheTitle;
FID:=TheID;
end;
constructor THelpNode.CreateURLID(TheOwner: THelpDatabase;
const TheTitle, TheURL, TheID: string);
begin
FOwner:=TheOwner;
FHelpType:=hntURLID;
FTitle:=TheTitle;
FURL:=TheURL;
FID:=TheID;
end;
constructor THelpNode.CreateContext(TheOwner: THelpDatabase;
const TheTitle: string; TheContext: THelpContext);
begin
FOwner:=TheOwner;
FHelpType:=hntContext;
FTitle:=TheTitle;
FContext:=TheContext;
end;
constructor THelpNode.CreateURLContext(TheOwner: THelpDatabase; const TheTitle,
TheURL: string; TheContext: THelpContext);
begin
FOwner:=TheOwner;
FHelpType:=hntURLContext;
FTitle:=TheTitle;
FURL:=TheURL;
FContext:=TheContext;
end;
function THelpNode.URLValid: boolean;
begin
Result:=FHelpType in [hntURLIDContext,hntURLID,hntURLContext];
end;
function THelpNode.IDValid: boolean;
begin
Result:=FHelpType in [hntURLIDContext,hntURLID,hntID];
end;
function THelpNode.ContextValid: boolean;
begin
Result:=FHelpType in [hntURLIDContext,hntURLContext,hntContext];
end;
procedure THelpNode.Assign(Source: TPersistent);
var
Node: THelpNode;
begin
if Source is THelpNode then begin
Node:=THelpNode(Source);
FHelpType:=Node.HelpType;
FTitle:=Node.Title;
FURL:=Node.URL;
FContext:=Node.Context;
end else
inherited Assign(Source);
end;
{ THelpDBSearchItem }
constructor THelpDBSearchItem.Create(TheNode: THelpNode);
begin
Node:=TheNode
end;
destructor THelpDBSearchItem.Destroy;
begin
Node.Free;
inherited Destroy;
end;
initialization

61
ideintf/objectinspector.pp
View File

@ -355,6 +355,20 @@ type
property Visible;
end;
{ TCustomPropertiesGrid }
TCustomPropertiesGrid = class(TOICustomPropertyGrid)
private
FAutoFreeHook: boolean;
function GetTIObject: TPersistent;
procedure SetAutoFreeHook(const AValue: boolean);
procedure SetTIObject(const AValue: TPersistent);
public
constructor Create(TheOwner: TComponent); override;
property TIObject: TPersistent read GetTIObject write SetTIObject;
property AutoFreeHook: boolean read FAutoFreeHook write SetAutoFreeHook;
end;
//============================================================================
@ -2989,5 +3003,52 @@ begin
RefreshPropertyValues;
end;
{ TCustomPropertiesGrid }
function TCustomPropertiesGrid.GetTIObject: TPersistent;
begin
if PropertyEditorHook<>nil then Result:=PropertyEditorHook.LookupRoot;
end;
procedure TCustomPropertiesGrid.SetAutoFreeHook(const AValue: boolean);
begin
if FAutoFreeHook=AValue then exit;
FAutoFreeHook:=AValue;
end;
procedure TCustomPropertiesGrid.SetTIObject(const AValue: TPersistent);
var
NewSelection: TPersistentSelectionList;
begin
if (TIObject=AValue) then begin
if ((AValue<>nil) and (Selection.Count=1) and (Selection[0]=AValue))
or (AValue=nil) then
exit;
end;
if PropertyEditorHook=nil then
PropertyEditorHook:=TPropertyEditorHook.Create;
PropertyEditorHook.LookupRoot:=AValue;
if (AValue<>nil) and ((Selection.Count<>1) or (Selection[0]<>AValue)) then
begin
NewSelection:=TPersistentSelectionList.Create;
try
if AValue<>nil then
NewSelection.Add(AValue);
Selection:=NewSelection;
finally
NewSelection.Free;
end;
end;
end;
constructor TCustomPropertiesGrid.Create(TheOwner: TComponent);
var
Hook: TPropertyEditorHook;
begin
Hook:=TPropertyEditorHook.Create;
AutoFreeHook:=true;
CreateWithParams(TheOwner,Hook,AllTypeKinds,25);
end;
end.

9
ideintf/objinspstrconsts.pas
View File

@ -93,6 +93,15 @@ resourcestring
// property editors
oisSort = 'Sort';
oisStringsEditorDialog = 'Strings Editor Dialog';
oisHelpTheHelpDatabaseWasUnableToFindFile = 'The help database %s%s%s was '
+'unable to find file %s%s%s.';
oisHelpTheMacroSInBrowserParamsWillBeReplacedByTheURL = 'The macro %s in '
+'BrowserParams will be replaced by the URL.';
oisHelpNoHTMLBrowserFoundPleaseDefineOneInHelpConfigureHe = 'No HTML '
+'Browser found.%sPlease define one in Help -> Configure Help -> Viewers';
oisHelpBrowserNotFound = 'Browser %s%s%s not found.';
oisHelpBrowserNotExecutable = 'Browser %s%s%s not executable.';
oisHelpErrorWhileExecuting = 'Error while executing %s%s%s:%s%s';
implementation

6
lcl/controls.pp
View File

@ -1634,7 +1634,7 @@ type
TDockTree = class;
{ TDockZone is a node in the TDockTree and encapsulates a region into which
other zones are contained. }
other zones or a single control are contained. }
TDockZone = class
private
@ -1647,7 +1647,6 @@ type
FOrientation: TDockOrientation;
FNextSibling: TDockZone;
FPrevSibling: TDockZone;
//FPrevSibling: TDockZone;
function GetHeight: Integer;
function GetLeft: Integer;
function GetLimitBegin: Integer;
@ -2409,6 +2408,9 @@ end.
{ =============================================================================
$Log$
Revision 1.239 2004/08/21 23:16:11 mattias
implemented simple HTML help viewer
Revision 1.238 2004/08/18 22:56:11 mattias
implemented basic manual docking