paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-13 11:59:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* lhelp now saves recent files and it's position/size

Browse Source 
git-svn-id: trunk@26914 -
This commit is contained in:
andrew 2010-07-30 21:20:46 +00:00
parent c426de02a7
commit 5cee5308ba
4 changed files with 187 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
components/chmhelp/lhelp/basecontentprovider.pas
View File

@ -5,7 +5,7 @@ unit BaseContentProvider;
interface
uses
Classes, SysUtils, Controls;
Classes, SysUtils, Controls, XMLCfg;
type
@ -16,6 +16,7 @@ type
private
fParent: TWinControl;
FTitle: String;
FConfig: TXMLConfig;
protected
fImageList: TImageList;
function GetTitle: String; virtual;
@ -28,8 +29,11 @@ type
procedure GoHome; virtual; abstract;
procedure GoBack; virtual; abstract;
procedure GoForward; virtual; abstract;
procedure LoadPreferences(ACfg: TXMLConfig); virtual;
procedure SavePreferences(ACfg: TXMLConfig); virtual;
class function GetProperContentProvider(const AURL: String): TBaseContentProviderClass; virtual; abstract;
constructor Create(AParent: TWinControl; AImageList: TImageList); virtual;
destructor Destroy; override;
property Parent: TWinControl read fParent;
property Title: String read GetTitle write SetTitle;
end;
@ -90,12 +94,28 @@ begin
FTitle := AValue;
end;
procedure TBaseContentProvider.LoadPreferences(ACfg: TXMLConfig);
begin
FConfig := ACfg;
end;
procedure TBaseContentProvider.SavePreferences(ACfg: TXMLConfig);
begin
end;
constructor TBaseContentProvider.Create(AParent: TWinControl; AImageList: TImageList);
begin
fParent:= AParent;
fImageList:= AImageList;
end;
destructor TBaseContentProvider.Destroy;
begin
SavePreferences(FConfig);
inherited Destroy;
end;
initialization
ContentProviders := TStringList.Create;

16
components/chmhelp/lhelp/chmcontentprovider.pas
View File

@ -21,7 +21,7 @@ unit chmcontentprovider;
interface
uses
Classes, SysUtils,
Classes, SysUtils, XMLCfg,
FileUtil, Forms, StdCtrls, ExtCtrls, ComCtrls, Controls, Buttons, Menus,
BaseContentProvider, FileContentProvider, IpHtml, ChmReader, ChmDataProvider;
@ -84,6 +84,8 @@ type
procedure SearchResultsDblClick(Sender: TObject);
procedure SearchComboKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
{$ENDIF}
procedure LoadPreferences(ACfg: TXMLConfig); override;
procedure SavePreferences(ACfg: TXMLConfig); override;
public
function CanGoBack: Boolean; override;
function CanGoForward: Boolean; override;
@ -580,6 +582,18 @@ begin
end;
end;
procedure TChmContentProvider.LoadPreferences(ACfg: TXMLConfig);
begin
inherited LoadPreferences(ACfg);
fTabsControl.Width := ACfg.GetValue(ClassName+'/TabControlWidth/Value', fTabsControl.Width);
end;
procedure TChmContentProvider.SavePreferences(ACfg: TXMLConfig);
begin
inherited SavePreferences(ACfg);
ACfg.SetValue(ClassName+'/TabControlWidth/Value', fTabsControl.Width);
end;
procedure TChmContentProvider.SearchButtonClick ( Sender: TObject ) ;
type
TTopicEntry = record

5
components/chmhelp/lhelp/lhelpcore.lfm
View File

@ -50,6 +50,7 @@ object HelpForm: THelpForm
OnClose = FormClose
OnCreate = FormCreate
OnKeyUp = FormKeyUp
OnShow = FormShow
Position = poScreenCenter
ShowInTaskBar = stAlways
LCLVersion = '0.9.29'
@ -264,6 +265,10 @@ object HelpForm: THelpForm
ShortCut = 16463
OnClick = FileMenuOpenItemClick
end
object FileMenuOpenRecentItem: TMenuItem
Caption = 'Open Recent'
Enabled = False
end
object FileMenuOpenURLItem: TMenuItem
Caption = 'Open &URL...'
OnClick = FileMenuOpenURLItemClick

166
components/chmhelp/lhelp/lhelpcore.pas
View File

@ -28,7 +28,7 @@ unit lhelpcore;
interface
uses
Classes, SysUtils, SimpleIPC,
Classes, SysUtils, SimpleIPC, XMLCfg,
FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
Buttons, LCLProc, StdCtrls, IpHtml, ComCtrls, ExtCtrls, Menus, LCLType,
BaseContentProvider, FileContentProvider, ChmContentProvider{$IFDEF USE_LNET}, HTTPContentProvider{$ENDIF};
@ -62,6 +62,7 @@ type
FileMenuOpenURLItem: TMenuItem;
HelpMenuItem: TMenuItem;
AboutItem: TMenuItem;
FileMenuOpenRecentItem: TMenuItem;
PageControl: TPageControl;
Panel1: TPanel;
ForwardBttn: TSpeedButton;
@ -79,6 +80,7 @@ type
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormShow(Sender: TObject);
procedure ForwardToolBtnClick(Sender: TObject);
procedure HomeToolBtnClick(Sender: TObject);
procedure PageControlChange(Sender: TObject);
@ -92,6 +94,12 @@ type
fOutputIPC: TSimpleIPCClient;
fServerTimer: TTimer;
fContext: LongInt; // used once when we are started on the command line with --context
fConfig: TXMLConfig;
FHasShowed: Boolean;
procedure LoadPreferences(AIPCName: String);
procedure SavePreferences(AIPCName: String);
procedure AddRecentFile(AFileName: String);
procedure OpenRecentItemClick(Sender: TObject);
procedure SendResponse(Response: DWord);
procedure ServerMessage(Sender: TObject);
procedure ReadCommandLineOptions;
@ -120,6 +128,13 @@ implementation
uses
LHelpControl;
type
TRecentMenuItem = class(TMenuItem)
public
URL: String;
end;
{ THelpForm }
@ -156,7 +171,8 @@ procedure THelpForm.FileMenuOpenItemClick(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
OpenURL('file://'+OpenDialog1.FileName);
if OpenURL('file://'+OpenDialog1.FileName) = Ord(srSuccess) then
AddRecentFile('file://'+OpenDialog1.FileName);
RefreshState;
end;
end;
@ -184,7 +200,8 @@ begin
if InputQuery('Please Enter a URL', 'Supported URL type(s): (' +URLSAllowed+ ')', fRes) then
begin
OpenURL(fRes);
if OpenURL(fRes) = ord(srSuccess) then
AddRecentFile(fRes);
RefreshState;
end;
end;
@ -195,6 +212,7 @@ begin
Application.ProcessMessages;
FileMenuCloseItemClick(Sender);
StopServer;
SavePreferences(fServerName);
end;
procedure THelpForm.FormCreate(Sender: TObject);
@ -205,7 +223,6 @@ begin
StartServer(fServerName);
end;
RefreshState;
SetKeyUp(Self);
end;
@ -216,6 +233,14 @@ begin
Close;
end;
procedure THelpForm.FormShow(Sender: TObject);
begin
if FHasShowed then
Exit;
FHasShowed := True;
LoadPreferences(fServerName);
end;
procedure THelpForm.ForwardToolBtnClick(Sender: TObject);
begin
if Assigned(ActivePage) then ActivePage.ContentProvider.GoForward;
@ -252,6 +277,85 @@ begin
end;
end;
procedure THelpForm.LoadPreferences(AIPCName: String);
var
PrefFile: String;
RecentCount: Integer;
i: Integer;
begin
PrefFile := GetAppConfigDirUTF8(False);
ForceDirectoriesUTF8(PrefFile);
PrefFile:=Format('%slhelp-%s.conf',[IncludeTrailingPathDelimiter(PrefFile), AIPCName]);
fConfig := TXMLConfig.Create(Self);
fConfig.Filename:=PrefFile;
Left := fConfig.GetValue('Position/Left/Value', Left);
Top := fConfig.GetValue('Position/Top/Value', Top);
Width := fConfig.GetValue('Position/Width/Value', Width);
Height := fConfig.GetValue('Position/Height/Value', Height);
RecentCount:= fConfig.GetValue('Recent/ItemCount/Value', 0);
for i := RecentCount-1 downto 0 do // downto since oldest are knocked off the list
AddRecentFile(fConfig.GetValue('Recent/Item/'+IntToStr(i)+'/Value',''));
end;
procedure THelpForm.SavePreferences(AIPCName: String);
var
i: Integer;
begin
fConfig.SetValue('Position/Left/Value', Left);
fConfig.SetValue('Position/Top/Value', Top);
fConfig.SetValue('Position/Width/Value', Width);
fConfig.SetValue('Position/Height/Value', Height);
fConfig.SetValue('Recent/ItemCount/Value', FileMenuOpenRecentItem.Count);
for i := 0 to FileMenuOpenRecentItem.Count-1 do // downto since oldest are knocked off the list
fConfig.SetValue('Recent/Item/'+IntToStr(i)+'/Value', TRecentMenuItem(FileMenuOpenRecentItem.Items[I]).URL);
fConfig.Flush;
fConfig.Free;
end;
procedure THelpForm.AddRecentFile(AFileName: String);
var
Item : TRecentMenuItem;
MaxHistory: longint;
i: Integer;
begin
for i := FileMenuOpenRecentItem.Count-1 downto 0 do
if TRecentMenuItem(FileMenuOpenRecentItem.Items[i]).URL = AFileName then
begin
FileMenuOpenRecentItem.Delete(i);
end;
Item := TRecentMenuItem.Create(FileMenuOpenRecentItem);
Item.Caption:=ExtractFileNameOnly(AFileName);
Item.URL:=AFileName;
Item.OnClick:=@OpenRecentItemClick;
Item.Hint:=Item.URL;
FileMenuOpenRecentItem.Insert(0, Item);
MaxHistory := fConfig.GetValue('Recent/HistoryCount/Value', 5);
if FileMenuOpenRecentItem.Count > 0 then
FileMenuOpenRecentItem.Enabled:=True;
if FileMenuOpenRecentItem.Count > MaxHistory then
FileMenuOpenRecentItem.Items[MaxHistory-1].Free;
end;
procedure THelpForm.OpenRecentItemClick(Sender: TObject);
var
Item: TRecentMenuItem absolute Sender;
begin
OpenURL(Item.URL);
AddRecentFile(Item.URL);
end;
procedure THelpForm.SendResponse(Response: DWord);
var
Stream: TMemoryStream;
@ -278,6 +382,7 @@ var
ConReq: TContextRequest;
Stream: TStream;
Res: LongWord;
Url: String;
begin
if fInputIPC.PeekMessage(5, True) then begin
Stream := fInputIPC.MsgData;
@ -285,25 +390,36 @@ begin
Stream.Read(FileReq, SizeOf(FileReq));
case FileReq.RequestType of
rtFile : begin
Res := OpenURL('file://'+FileReq.FileName);
Url := 'file://'+FileReq.FileName;
Res := OpenURL(URL);
end;
rtUrl : begin
Stream.Position := 0;
Stream.Read(UrlReq, SizeOf(UrlReq));
if UrlReq.FileRequest.FileName <> '' then
Res := OpenUrl('file://'+UrlReq.FileRequest.FileName+'://'+UrlReq.Url)
begin
Url := 'file://'+UrlReq.FileRequest.FileName;
Res := OpenUrl(URL+'://'+UrlReq.Url)
end
else
Res := OpenURL(UrlReq.Url);
begin
Url := UrlReq.Url;
Res := OpenURL(Url);
end;
end;
rtContext : begin
Stream.Position := 0;
Stream.Read(ConReq, SizeOf(ConReq));
Res := OpenURL('file://'+FileReq.FileName, ConReq.HelpContext);
Url := 'file://'+FileReq.FileName;
Res := OpenURL(Url, ConReq.HelpContext);
end;
end;
if Res = Ord(srSuccess) then
AddRecentFile(Url);
SendResponse(Res);
Self.SendToBack;
Self.BringToFront;
Self.ShowOnTop;
end;
end;
@ -394,7 +510,7 @@ var
fURLPrefix: String;
fContentProvider: TBaseContentProviderClass;
fRealContentProvider: TBaseContentProviderClass;
fNewPage: TContentTab;
fPage: TContentTab = nil;
I: Integer;
begin
Result := Ord(srUnknown);
@ -417,6 +533,7 @@ begin
for I := 0 to PageControl.PageCount-1 do begin
if fRealContentProvider.ClassName = TContentTab(PageControl.Pages[I]).ContentProvider.ClassName then begin
fPage := TContentTab(PageControl.Pages[I]);
if TContentTab(PageControl.Pages[I]).ContentProvider.LoadURL(AURL, AContext) then
begin
PageControl.ActivePage := PageControl.Pages[I];
@ -427,27 +544,36 @@ begin
Exit;
end;
end;
//no page was found already to handle this content so create one
fNewPage := TContentTab.Create(PageControl);
fNewPage.ContentProvider := fRealContentProvider.Create(fNewPage, ImageList1);
fNewPage.Parent := PageControl;
SetKeyUp(fNewPage);
ShowOnTop;
if fNewPage.ContentProvider.LoadURL(AURL, AContext) then
if fPage = nil then
begin
PageControl.ActivePage := fNewPage;
//no page was found already to handle this content so create one
fPage := TContentTab.Create(PageControl);
fPage.ContentProvider := fRealContentProvider.Create(fPage, ImageList1);
fPage.Parent := PageControl;
SetKeyUp(fPage);
fPage.ContentProvider.LoadPreferences(fConfig);
end;
if fPage.ContentProvider.LoadURL(AURL, AContext) then
begin
PageControl.ActivePage := fPage;
RefreshState;
Result := Ord(srSuccess);
end
else
Result := Ord(srInvalidFile);
ShowOnTop;
end;
procedure THelpForm.LateOpenURL ( Url: PStringItem ) ;
begin
OpenURL(URL^.FString, fContext);
if OpenURL(URL^.FString, fContext) = ord(srSuccess) then
AddRecentFile(URL^.FString);
Dispose(Url);
RefreshState;
end;