Tried to play a bit with WebKit/Gtk using the current Free Pascal (SVN) version. Proof of concept on Linux (only) is below. Don't expect the program to run and/or compile on Windows without modifications.
program GtkLauncher;
{$mode objfpc}{$H+}
{ This is a FPC port/modification of the original source from:
http://trac.webkit.org/browser/trunk/WebKitTools/GtkLauncher/main.c
- Tested on Linux only.
- Depends on the libwebkit[-dev] package (which is not installed by default
at least on Ubuntu).
- You must include the protocol specifier when entering an uri in the address
edit box, eg. 'http://google.com' and not just 'google.com' as you can
in most real browsers.
/*
* Copyright (C) 2006, 2007 Apple Inc.
* Copyright (C) 2007 Alp Toker <alp@atoker.com>
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED BY APPLE COMPUTER, INC. ``AS IS'' AND ANY
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL APPLE COMPUTER, INC. OR
* CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
* EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
* PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY
* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
}
uses
gtk2, glib2, math;
const
LIB = 'webkit-1.0';
type
WebKitWebView = record
parent_instance: TGtkContainer;
priv: pointer;
end;
PWebKitWebView = ^WebKitWebView;
WebKitWebFrame = record
parent_instance: PGObject;
priv: pointer;
end;
PWebKitWebFrame = ^WebKitWebFrame;
var
load_progress: gint = 0;
main_statusbar: PGtkStatusbar = nil;
main_title: pgchar = nil;
main_window: PGtkWidget = nil;
status_context_id: guint = 0;
uri_entry: PGtkWidget = nil;
web_view: PWebKitWebView = nil;
function web_view_new: PGtkWidget; cdecl; external LIB name 'webkit_web_view_new';
procedure web_view_go_back(web_view: PWebKitWebView); cdecl; external LIB name 'webkit_web_view_go_back';
procedure web_view_go_forward(web_view: PWebKitWebView); cdecl; external LIB name 'webkit_web_view_go_forward';
procedure web_view_open(web_view: PWebKitWebView; uri: Pgchar); cdecl; external LIB name 'webkit_web_view_open';
procedure activate_uri_entry_cb(entry: PGtkWidget; data: gpointer); cdecl;
var uri: Pgchar;
begin
uri := gtk_entry_get_text(GTK_ENTRY(entry));
assert(assigned(uri));
web_view_open(web_view, uri);
end;
procedure update_title (window: PGtkWindow);
var
string_: PGString;
title: Pgchar;
begin
string_ := g_string_new(main_title);
g_string_append(string_, ' - FPC WebKit/Gtk Launcher');
if load_progress < 100 then
g_string_append_printf(string_, ' (%d%%)', load_progress);
title := g_string_free(string_, false);
gtk_window_set_title(window, title);
g_free(title);
end;
procedure link_hover_cb(page: PWebKitWebView; const title: pgchar; const link: pgchar; data: gpointer); cdecl;
begin
gtk_statusbar_pop(main_statusbar, status_context_id);
if assigned(link) then
gtk_statusbar_push(main_statusbar, status_context_id, link);
end;
procedure title_change_cb(web_view: PWebKitWebView; web_frame: PWebKitWebFrame; const title: pgchar; data: gpointer); cdecl;
begin
if assigned(main_title) then
g_free(main_title);
main_title := g_strdup(title);
update_title(GTK_WINDOW(main_window));
end;
procedure progress_change_cb(page: PWebKitWebView; progress: gint; data: gpointer); cdecl;
begin
load_progress := progress;
update_title(GTK_WINDOW(main_window));
end;
procedure destroy_cb(widget: pGtkWidget; data: gpointer); cdecl;
begin
gtk_main_quit;
end;
procedure go_back_cb(widget: PGtkWidget; data: gpointer); cdecl;
begin
web_view_go_back(web_view);
end;
procedure go_forward_cb(widget: PGtkWidget; data: gpointer); cdecl;
begin
web_view_go_forward(web_view);
end;
function create_browser: PGtkWidget;
begin
result := gtk_scrolled_window_new(nil, nil);
gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(result), GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
web_view := PWebKitWebView(web_view_new);
gtk_container_add(GTK_CONTAINER(result), GTK_WIDGET(web_view));
g_signal_connect(web_view, 'title-changed', G_CALLBACK(@title_change_cb), web_view);
g_signal_connect(web_view, 'load-progress-changed', G_CALLBACK(@progress_change_cb), web_view);
g_signal_connect(web_view, 'hovering-over-link', G_CALLBACK(@link_hover_cb), web_view);
end;
function create_statusbar: PGtkWidget;
begin
main_statusbar := GTK_STATUSBAR(gtk_statusbar_new);
status_context_id := gtk_statusbar_get_context_id(main_statusbar, 'Link Hover');
result := PGtkWidget(main_statusbar);
end;
function create_toolbar: PGtkWidget;
var item: PGtkToolItem;
begin
result := gtk_toolbar_new;
gtk_toolbar_set_orientation(GTK_TOOLBAR(result), GTK_ORIENTATION_HORIZONTAL);
gtk_toolbar_set_style(GTK_TOOLBAR(result), GTK_TOOLBAR_BOTH_HORIZ);
item := gtk_tool_button_new_from_stock(GTK_STOCK_GO_BACK);
g_signal_connect(G_OBJECT(item), 'clicked', G_CALLBACK(@go_back_cb), nil);
gtk_toolbar_insert(GTK_TOOLBAR(result), item, -1);
item := gtk_tool_button_new_from_stock(GTK_STOCK_GO_FORWARD);
g_signal_connect(G_OBJECT(item), 'clicked', G_CALLBACK(@go_forward_cb), nil);
gtk_toolbar_insert(GTK_TOOLBAR(result), item, -1);
item := gtk_tool_item_new;
gtk_tool_item_set_expand(item, true);
uri_entry := gtk_entry_new;
gtk_container_add(GTK_CONTAINER(item), uri_entry);
g_signal_connect(G_OBJECT(uri_entry), 'activate', G_CALLBACK(@activate_uri_entry_cb), nil);
gtk_toolbar_insert(GTK_TOOLBAR(result), item, -1);
item := gtk_tool_button_new_from_stock(GTK_STOCK_OK);
g_signal_connect_swapped(G_OBJECT(item), 'clicked', G_CALLBACK(@activate_uri_entry_cb), gpointer(uri_entry));
gtk_toolbar_insert(GTK_TOOLBAR(result), item, -1);
end;
function create_window: PGtkWidget;
begin
result := gtk_window_new(GTK_WINDOW_TOPLEVEL);
gtk_window_set_default_size(PGtkWindow(result), 800, 600);
gtk_widget_set_name(result, 'FPC GtkLauncher');
g_signal_connect(result, 'destroy', G_CALLBACK(@destroy_cb), nil);
end;
var vbox: PGtkWidget;
begin
math.SetExceptionMask([exInvalidOp, exPrecision]); // strange magic, removes webkit's SIGFPE
gtk_init(@argc,@argv);
vbox := gtk_vbox_new(false, 0);
gtk_box_pack_start(PGtkBox(vbox), create_toolbar, false, false, 0);
gtk_box_pack_start(PGtkBox(vbox), create_browser, true, true, 0);
gtk_box_pack_start(PGtkBox(vbox), create_statusbar, false, false, 0);
main_window := create_window;
gtk_container_add(PGtkContainer(main_window), vbox);
web_view_open(web_view, 'http://www.freepascal.org');
gtk_widget_grab_focus(GTK_WIDGET(web_view));
gtk_widget_show_all(main_window);
gtk_main;
end.
You should get something like this at runtime:
Posts
