attached a patch that will change:- changes in iphtml.pas,iputils.pas and ipfilebroker.pas (against original contents from ipbroker.pas) are now within ifdef IP_LAZARUS
- added a hack for the registry for 2.0.2 as described by Jesus
ipfilebroker.patch changes iphtml, iputils and adds the definitions for ipfilebroker.pas to the package
ipfilebroker.pas.gz is the new ipfilebroker.pas (i cant see the old version in svn)
Armin Diehl wrote:
yes, i will provide a diff within the next days, was on a short vacation Jesus Reyes wrote:--- Mattias Gaertner <[EMAIL PROTECTED]> escribió:On Fri, 09 Jun 2006 21:17:55 +0200 Armin Diehl <[EMAIL PROTECTED]> wrote:brokerthis patch and components/turbopower_ipro/ipfilebroker.pas adds afunctionsfor local files to the ipro html viewer. In addition two newsample onare added to the html viewer (canGoBack and canGoForward). Ahow to use this for showing help will follow.Thanks. Added. Forget my other mail. MattiasAnyway, it would be nice to have a patch to fix the fpc 202 version issues in linux and windows, and to wrap ip_pro additions with IP_LAZARUS. Jesus Reyes A.
ipfilebroker.pas.gz
Description: GNU Zip compressed data
Index: iphtml.pas
===================================================================
--- iphtml.pas (revision 9497)
+++ iphtml.pas (working copy)
@@ -2759,9 +2759,13 @@
procedure CopyToClipboard;
procedure EnumDocuments(Enumerator: TIpHtmlEnumerator);
procedure GoBack;
+ {$IFDEF IP_LAZARUS}
function canGoBack : boolean;
+ {$ENDIF}
procedure GoForward;
+ {$IFDEF IP_LAZARUS}
function canGoForward : boolean;
+ {$ENDIF}
function HaveSelection: Boolean;
property HotNode : TIpHtmlNode read FHotNode; {!!.12}
function IsURLHtml(const URL: string): Boolean;
@@ -17443,18 +17447,25 @@
procedure TIpHtmlCustomPanel.GoBack;
begin
if (URLStack.Count > 0) then begin
+ {$IFDEF IP_LAZARUS}
if URLStack.Count >= URLStack.count then Stp := URLStack.Count - 1;
if URLStack.Count > 0 then begin
InternalOpenURL(TargetStack[Stp], URLStack[Stp]);
dec(Stp);
end;
+ {$ELSE}
+ InternalOpenURL(TargetStack[Stp], URLStack[Stp]);
+ dec(Stp);
+ {$ENDIF}
end;
end;
+{$IFDEF IP_LAZARUS}
function TIpHtmlCustomPanel.canGoBack : boolean;
begin
result := (URLStack.Count > 0);
end;
+{$ENDIF}
procedure TIpHtmlCustomPanel.GoForward;
begin
@@ -17464,10 +17475,12 @@
end;
end;
+{$IFDEF IP_LAZARUS}
function TIpHtmlCustomPanel.canGoForward : boolean;
begin
result := (Stp < URLStack.Count - 1);
end;
+{$ENDIF}
procedure TIpHtmlCustomPanel.Push(const Target, URL: string);
begin
Index: turbopoweripro.pas
===================================================================
--- turbopoweripro.pas (revision 9497)
+++ turbopoweripro.pas (working copy)
@@ -7,13 +7,14 @@
interface
uses
- IpAnim, IpConst, IpHtml, IpHtmlPv, IpMsg, IpStrms, IpUtils,
+ IpAnim, IpConst, Ipfilebroker, IpHtml, IpHtmlPv, IpMsg, IpStrms, IpUtils,
LazarusPackageIntf;
implementation
procedure Register;
begin
+ RegisterUnit('Ipfilebroker', @Ipfilebroker.Register);
RegisterUnit('IpHtml', @IpHtml.Register);
end;
Index: turbopoweripro.lpk
===================================================================
--- turbopoweripro.lpk (revision 9497)
+++ turbopoweripro.lpk (working copy)
@@ -41,7 +41,7 @@
</Item4>
<Item5>
<Filename Value="ipfilebroker.pas"/>
- <AddToUsesPkgSection Value="False"/>
+ <HasRegisterProc Value="True"/>
<UnitName Value="Ipfilebroker"/>
</Item5>
<Item6>
Index: iputils.pas
===================================================================
--- iputils.pas (revision 9497)
+++ iputils.pas (working copy)
@@ -42,6 +42,7 @@
LCLIntf,
LMessages,
FileUtil,
+ LCLProc,
{$ELSE}
Messages,
Windows,
@@ -1170,7 +1171,11 @@
for i := 1 to Length(Result) do begin
case Result[i] of
'|': Result[i] := ':';
+ {$IFDEF IP_LAZARUS}
+ '/': Result[i] := DirectorySeparator;
+ {$ELSE}
'/': Result[i] := '\';
+ {$ENDIF}
else
{ leave it alone };
end;
@@ -1191,7 +1196,11 @@
for i := 1 to Length(Result) do begin
case Result[i] of
':': Result[i] := '|';
+ {$IFDEF IP_LAZARUS}
+ DirectorySeparator: Result[i] := '/';
+ {$ELSE}
'\': Result[i] := '/';
+ {$ENDIF}
else
{ leave it alone };
end;
@@ -1296,6 +1305,9 @@
State : TUrlParseState;
PotAuth, PotPath : string;
SchemeSeen: Boolean;
+ {$IFDEF IP_LAZARUS}
+ SlashCount: integer;
+ {$ENDIF}
procedure ProcessChar;
begin
@@ -1374,6 +1386,9 @@
SchemeSeen := True;
PotAuth := '';
State := psSchemeSlashes;
+ {$IFDEF IP_LAZARUS}
+ SlashCount := 0;
+ {$ENDIF}
end
else begin
@@ -1427,6 +1442,9 @@
SchemeSeen := True;
PotAuth := '';
State := psSchemeSlashes;
+ {$IFDEF IP_LAZARUS}
+ SlashCount := 0;
+ {$ENDIF}
end;
'A'..'Z', 'a'..'z': begin
@@ -1453,10 +1471,16 @@
end;
psSchemeSlashes: begin
+ {$IFDEF IP_LAZARUS}
+ inc(SlashCount);
+ if (p^ <> '/') or (SlashCount > 2) then
+ {$ENDIF}
case P^ of
+ {$IFNDEF IP_LAZARUS}
'/': { ignore };
+ {$ENDIF}
- '.', '\': begin { start of a local path } {!!.12}
+ '.', '\','/': begin { start of a local path }
{!!.12}
PotPath := PotPath + P^; {!!.12}
State := psLocalPath; {!!.12}
end; {!!.12}
@@ -2666,14 +2690,69 @@
{ File/Directory Stuff }
{ Retreive Windows "MIME" type for a particular file extension }
+{$IFDEF IP_LAZARUS}
+{$ifndef MSWindows}
+{define some basic mime types}
+const MimeTypeExt : Array[0..4] of String =
('.htm','.html','.txt','.jpg','.png');
+ MimeTypes : Array[0..4] of String =
('text/html','text/html','text/plain','image/jpeg','image/png');
+{$endif}
+
+{$IFDEF VER2_0_2}
+type
+ TMyRegistry=Class(TRegistry);
+{$ENDIF}
function GetLocalContent(const TheFileName: string): string;
var
Reg : TRegistry;
Ext : string;
+ {$ifndef MSWindows}
+ ExtU: string;
+ i : integer;
+ {$ENDIF}
begin
Result := '';
Ext := ExtractFileExt(TheFileName);
+ {$ifndef MSWindows}
+ ExtU := AnsiLowerCase(Ext);
+ for i := 0 to high(MimeTypeExt) do
+ if MimeTypeExt[i] = ExtU then
+ begin
+ result := MimeTypes[i];
+ break;
+ end;
+ {$endif}
+ if result = '' then
+ begin
+ Reg := nil;
+ try
+ {$IFDEF VER2_0_2}
+ Reg := TMyRegistry.Create;
+ Reg.RootKey := HKEY_CLASSES_ROOT;
+ TMyRegistry(Reg).SetCurrentKey(Reg.RootKey);
+ {$ELSE}
+ Reg := TRegistry.Create;
+ Reg.RootKey := HKEY_CLASSES_ROOT;
+ {$ENDIF}
+ if Reg.OpenKey(Ext, False) then
+ Result := Reg.ReadString('Content Type');
+ finally
+ Reg.CloseKey;
+ Reg.Free;
+ end;
+ end;
+ DebugLn('IpUtils.GetLocalContent File:'+TheFileName+' Result:'+result);
+end;
+{$ELSE}
+{ Retreive Windows "MIME" type for a particular file extension }
+function GetLocalContent(const TheFileName: string): string;
+var
+ Reg : TRegistry;
+ Ext : string;
+begin
+ Result := '';
+ Ext := ExtractFileExt(TheFileName);
+
Reg := nil;
try
Reg := TRegistry.Create;
@@ -2685,6 +2764,7 @@
Reg.Free;
end;
end;
+{$ENDIF}
{ Determine if a directory exists }
function DirExists(Dir : string): Boolean;
