paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-03 08:19:26 +01:00
Code Issues Packages Projects Releases Wiki Activity

turbo ipro: using exclusive stream

Browse Source 
git-svn-id: trunk@31030 -
This commit is contained in:
mattias 2011-06-03 21:02:05 +00:00
parent 39474920c0
commit 30b260c5b6
6 changed files with 120 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
components/turbopower_ipro/design/ipidehtmlcontrol.pas
View File

@ -55,11 +55,16 @@ type
FIDEProvider: TAbstractIDEHTMLProvider;
FIPHTMLPanel: TIpHtmlPanel;
FURL: string;
procedure SetIDEProvider(const AValue: TAbstractIDEHTMLProvider);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetURL: string;
procedure SetURL(const AValue: string);
property IDEProvider: TAbstractIDEHTMLProvider read FIDEProvider write FIDEProvider;
property IDEProvider: TAbstractIDEHTMLProvider read FIDEProvider write SetIDEProvider;
procedure SetHTMLContent(Stream: TStream; const NewURL: string);
procedure GetPreferredControlSize(out AWidth, AHeight: integer);
property IPHTMLPanel: TIpHtmlPanel read FIPHTMLPanel;
@ -82,11 +87,12 @@ function IPCreateLazIDEHTMLControl(Owner: TComponent;
var
HTMLControl: TLazIPHtmlControl;
begin
//debugln(['IPCreateLazIDEHTMLControl ']);
HTMLControl:=TLazIPHtmlControl.Create(Owner);
Result:=HTMLControl;
if Provider=nil then
Provider:=CreateIDEHTMLProvider(HTMLControl);
Provider.ControlIntf:=HTMLControl;
//debugln(['IPCreateLazIDEHTMLControl Provider=',DbgSName(Provider)]);
HTMLControl.IDEProvider:=Provider;
end;
@ -94,8 +100,8 @@ end;
function TLazIpHtmlDataProvider.DoGetStream(const URL: string): TStream;
begin
debugln(['TLazIpHtmlDataProvider.DoGetStream ',URL]);
Result:=Control.IDEProvider.GetStream(URL);
debugln(['TLazIpHtmlDataProvider.DoGetStream ',URL,' ',DbgSName(Control.IDEProvider)]);
Result:=Control.IDEProvider.GetStream(URL,false);
end;
{ TLazIPHtmlControl }
@ -152,7 +158,7 @@ begin
// quick check if file format is supported (raises an exception)
Picture.FindGraphicClassWithFileExt(Ext);
// get stream
Stream:=IDEProvider.GetStream(NewURL);
Stream:=IDEProvider.GetStream(NewURL,true);
// load picture
Picture.LoadFromStreamWithFileExt(Stream,Ext);
finally
@ -178,6 +184,34 @@ begin
debugln(['TLazIPHtmlControl.DataProviderReportReference URL=',URL]);
end;
procedure TLazIPHtmlControl.SetIDEProvider(
const AValue: TAbstractIDEHTMLProvider);
begin
if FIDEProvider=AValue then exit;
//debugln(['TLazIPHtmlControl.SetIDEProvider Old=',DbgSName(FIDEProvider),' New=',DbgSName(FIDEProvider)]);
if FIDEProvider<>nil then begin
IDEProvider.ControlIntf:=nil;
end;
FIDEProvider:=AValue;
if FIDEProvider<>nil then begin
FreeNotification(FIDEProvider);
IDEProvider.ControlIntf:=Self;
end;
end;
procedure TLazIPHtmlControl.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation=opRemove then begin
if IDEProvider=AComponent then begin
if IDEProvider.ControlIntf=TIDEHTMLControlIntf(Self) then
IDEProvider.ControlIntf:=nil;
IDEProvider:=nil;
end;
end;
end;
constructor TLazIPHtmlControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@ -190,7 +224,7 @@ begin
MarginWidth:=2;
Parent:=Self;
end;
FIPHTMLPanel.DataProvider:=TLazIpHtmlDataProvider.Create(Self);
FIPHTMLPanel.DataProvider:=TLazIpHtmlDataProvider.Create(FIPHTMLPanel);
with TLazIpHtmlDataProvider(FIPHTMLPanel.DataProvider) do begin
FControl:=Self;
Name:='TLazIPHtmlControlDataProvider';
@ -205,6 +239,13 @@ begin
BevelInner:=bvLowered;
end;
destructor TLazIPHtmlControl.Destroy;
begin
//debugln(['TLazIPHtmlControl.Destroy ',DbgSName(Self),' ',dbgs(Pointer(Self))]);
FreeAndNil(FIDEProvider);
inherited Destroy;
end;
function TLazIPHtmlControl.GetURL: string;
begin
Result:=FURL;
@ -223,7 +264,7 @@ begin
if FURL=NewURL then exit;
FURL:=NewURL;
try
Stream:=IDEProvider.GetStream(FURL);
Stream:=IDEProvider.GetStream(FURL,true);
ok:=false;
NewHTML:=nil;
try

28
components/turbopower_ipro/ipcss.inc
View File

@ -87,21 +87,21 @@
{$ELSE implementation}
type
{ TCSSReader }
{ TCSSReader }
TCSSReader = class
FStream: TStream;
FGlobalProps: TCSSGlobalProps;
function GetStatementElements(AStatement: String): TStringList;
function GetStatementCommands(AStatement: String): TStringList;
function CheckIsComment: Boolean;
procedure EatWhiteSpace;
procedure ParseCSS;
procedure EatComment;
function FindStatement(out AStatement: String): Boolean;
function EOF: Boolean;
constructor Create(AStream: TStream; AGlobalProps: TCSSGlobalProps);
end;
TCSSReader = class
FStream: TStream;
FGlobalProps: TCSSGlobalProps;
function GetStatementElements(AStatement: String): TStringList;
function GetStatementCommands(AStatement: String): TStringList;
function CheckIsComment: Boolean;
procedure EatWhiteSpace;
procedure ParseCSS;
procedure EatComment;
function FindStatement(out AStatement: String): Boolean;
function EOF: Boolean;
constructor Create(AStream: TStream; AGlobalProps: TCSSGlobalProps);
end;
function IsWhiteSpace(AChar: Char; ExcludeSpaces: Boolean = False): Boolean;
begin

20
components/turbopower_ipro/iphtml.pas
View File

@ -3156,6 +3156,8 @@ type
procedure EraseBackground(DC: HDC); {$IFDEF IP_LAZARUS} override; {$ENDIF} //JMN
end;
{ TIpAbstractHtmlDataProvider }
TIpAbstractHtmlDataProvider = class(TIpBaseComponent)
protected
function DoGetHtmlStream(const URL: string;
@ -3328,6 +3330,7 @@ type
FCurElement : PIpHtmlElement;
FPrintSettings: TIpHtmlPrintSettings; {!!.10}
FFactBAParag: Real; //JMN
procedure SetDataProvider(const AValue: TIpAbstractHtmlDataProvider);
procedure SetFactBAParag(const Value: Real); //JMN
function FactBAParagNotIs1: Boolean;
function GetVScrollPos: Integer; //JMN
@ -3438,7 +3441,7 @@ type
default True;
property CurElement : PIpHtmlElement read FCurElement;
property DataProvider: TIpAbstractHtmlDataProvider
read FDataProvider write FDataProvider;
read FDataProvider write SetDataProvider;
property FactBAParag: Real
read FFactBAParag write SetFactBAParag stored FactBAParagNotIs1; //JMN
property FlagErrors : Boolean
@ -18030,15 +18033,16 @@ begin
if FFramePanel <> nil then {!!.12}
FFramePanel.OnResize := nil; {!!.12}
for i := 0 to Pred(FFrameCount) do
FFrames[i].Free;
FreeAndNil(FFrames[i]);
if HyperPanel <> nil then begin
HyperPanel.Hyper := nil;
HyperPanel.Free;
HyperPanel := nil;
end;
//debugln(['TIpHtmlFrame.Destroy ',DbgSName(Self),' ',dbgs(Pointer(FDataProvider))]);
if (FDataProvider <> nil) and (not (csDestroying in FDataProvider.ComponentState)) then
FDataProvider.DoLeave(FHtml);
FHtml.Free;
FreeAndNil(FHtml);
inherited;
end;
@ -19163,6 +19167,7 @@ end;
procedure TIpHtmlCustomPanel.Notification(AComponent: TComponent; Operation: TOperation);
begin
//debugln(['TIpHtmlCustomPanel.Notification ',DbgSName(Self),' ',dbgs(Pointer(Self)),' AComponent=',DbgSName(AComponent),' ',dbgs(Pointer(AComponent))]);
if (Operation = opRemove) then
if (AComponent = DataProvider) then begin
DataProvider := nil;
@ -19537,6 +19542,15 @@ begin
FFactBAParag := V;
end;
procedure TIpHtmlCustomPanel.SetDataProvider(
const AValue: TIpAbstractHtmlDataProvider);
begin
if FDataProvider=AValue then exit;
//debugln(['TIpHtmlCustomPanel.SetDataProvider Old=',DbgSName(FDataProvider),' ',dbgs(Pointer(FDataProvider)),' New=',DbgSName(AValue),' ',dbgs(Pointer(AValue))]);
FDataProvider:=AValue;
if FDataProvider<>nil then FreeNotification(FDataProvider);
end;
function TIpHtmlCustomPanel.FactBAParagNotIs1: Boolean; //JMN
begin
Result := FactBAParag <> 1;

42
ide/idehelpmanager.pas
View File

@ -74,7 +74,7 @@ type
FProviders: TLIHProviders;
procedure SetProviders(const AValue: TLIHProviders);
public
function GetStream(const URL: string): TStream; override;
function GetStream(const URL: string; Shared: Boolean): TStream; override;
procedure ReleaseStream(const URL: string); override;
property Providers: TLIHProviders read FProviders write SetProviders;
end;
@ -103,7 +103,7 @@ type
constructor Create;
destructor Destroy; override;
function FindStream(const URL: string; CreateIfNotExists: Boolean): TLIHProviderStream;
function GetStream(const URL: string): TStream;
function GetStream(const URL: string; Shared: boolean): TStream;
procedure ReleaseStream(const URL: string);
end;
@ -461,12 +461,15 @@ begin
if FURL=NewURL then exit;
FURL:=NewURL;
try
Stream:=Provider.GetStream(FURL);
SetLength(s,Stream.Size);
if s<>'' then
Stream.Read(s[1],length(s));
Caption:=HTMLToCaption(s,MaxLineCount);
Provider.ReleaseStream(FURL);
Stream:=Provider.GetStream(FURL,true);
try
SetLength(s,Stream.Size);
if s<>'' then
Stream.Read(s[1],length(s));
Caption:=HTMLToCaption(s,MaxLineCount);
finally
Provider.ReleaseStream(FURL);
end;
except
on E: Exception do begin
Caption:=E.Message;
@ -521,9 +524,10 @@ begin
FProviders:=AValue;
end;
function TLazIDEHTMLProvider.GetStream(const URL: string): TStream;
function TLazIDEHTMLProvider.GetStream(const URL: string; Shared: Boolean
): TStream;
begin
Result:=FProviders.GetStream(URL);
Result:=FProviders.GetStream(URL,Shared);
end;
procedure TLazIDEHTMLProvider.ReleaseStream(const URL: string);
@ -563,7 +567,7 @@ begin
Result:=nil;
end;
function TLIHProviders.GetStream(const URL: string): TStream;
function TLIHProviders.GetStream(const URL: string; Shared: boolean): TStream;
procedure OpenFile(out Stream: TStream; const Filename: string;
UseCTCache: boolean);
@ -611,9 +615,14 @@ var
URLParams: string;
begin
if URL='' then raise Exception.Create('TLIHProviders.GetStream no URL');
Stream:=FindStream(URL,true);
Stream.IncreaseRefCount;
Result:=Stream.Stream;
if Shared then begin
Stream:=FindStream(URL,true);
Stream.IncreaseRefCount;
Result:=Stream.Stream;
end else begin
Stream:=nil;
Result:=nil;
end;
try
if Result=nil then begin
SplitURL(URL,URLType,URLPath,URLParams);
@ -640,10 +649,11 @@ begin
Result.Position:=0;}
if Result=nil then
raise Exception.Create('TLIHProviders.GetStream: URL not found "'+dbgstr(URL)+'"');
Stream.Stream:=Result;
if Stream<>nil then
Stream.Stream:=Result;
end;
finally
if Result=nil then
if (Result=nil) and (Stream<>nil) then
ReleaseStream(URL);
end;
end;

10
ide/sourceeditor.pp
View File

@ -6326,8 +6326,16 @@ begin
end;
if SourceCompletionTimer<>nil then
SourceCompletionTimer.Enabled:=false;
if FHintWindow<>nil then
if FHintWindow<>nil then begin
FHintWindow.Visible:=false;
FHintWindow.DisableAutoSizing;
try
while FHintWindow.ControlCount>0 do
FHintWindow.Controls[0].Free;
finally
FHintWindow.EnableAutoSizing;
end;
end;
end;
procedure TSourceNotebook.StartShowCodeContext(JumpToError: boolean);

19
ideintf/idehelpintf.pas
View File

@ -102,18 +102,18 @@ type
FBaseURL: string;
FControlIntf: TIDEHTMLControlIntf;
procedure SetBaseURL(const AValue: string); virtual;
procedure SetControlIntf(const AValue: TIDEHTMLControlIntf); virtual;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
function GetStream(const URL: string
): TStream; virtual; abstract; { provider assumes ownership of returned TStream
and increases internal reference count.
If not found it raises an exception. }
function GetStream(const URL: string; Shared: boolean
): TStream; virtual; abstract; { Shared=true: provider assumes ownership
of returned TStream and increases internal reference count.
If not found it raises an exception.
Shared=false: caller must free stream}
procedure ReleaseStream(const URL: string); virtual; abstract;
property BaseURL: string read FBaseURL write SetBaseURL;// fallback for relative URLs
function MakeURLAbsolute(const aBaseURL, aURL: string): string; virtual;
property ControlIntf: TIDEHTMLControlIntf read FControlIntf write SetControlIntf;
property ControlIntf: TIDEHTMLControlIntf read FControlIntf write FControlIntf;
end;
TCreateIDEHTMLControlEvent =
@ -157,13 +157,6 @@ begin
FBaseURL:=AValue;
end;
procedure TAbstractIDEHTMLProvider.SetControlIntf(
const AValue: TIDEHTMLControlIntf);
begin
if FControlIntf=AValue then exit;
FControlIntf:=AValue;
end;
constructor TAbstractIDEHTMLProvider.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);