#!/usr/bin/perl -w
#
# Application main window
#
# Demonstrates a typical application window, with menubar, toolbar, statusbar.
#
package appwindow;
use Glib ':constants';
use Gtk2;
#include "demo-common.h"
my $window = undef;
sub menuitem_cb {
my ($callback_data, $callback_action, $widget) = @_;
my $dialog = Gtk2::MessageDialog->new ($callback_data,
'destroy-with-parent',
'info',
'close',
sprintf "You selected or toggled the menu item: \"%s\"",
Gtk2::ItemFactory->path_from_widget ($widget));
# Close dialog on user response
$dialog->signal_connect (response => sub { $dialog->destroy; 1 });
$dialog->show;
}
my @menu_items = (
[ "/_File", undef, undef, 0, "<Branch>" ],
[ "/File/_New", "<control>N", \&menuitem_cb, 0, "<StockItem>", 'gtk-new' ],
[ "/File/_Open", "<control>O", \&menuitem_cb, 0, "<StockItem>", 'gtk-open' ],
[ "/File/_Save", "<control>S", \&menuitem_cb, 0, "<StockItem>", 'gtk-save' ],
[ "/File/Save _As...", undef, \&menuitem_cb, 0, "<StockItem>", 'gtk-save' ],
[ "/File/sep1", undef, \&menuitem_cb, 0, "<Separator>" ],
[ "/File/_Quit", "<control>Q", \&menuitem_cb, 0, "<StockItem>", 'gtk-quit' ],
[ "/_Preferences", undef, undef, 0, "<Branch>" ],
[ "/_Preferences/_Color", undef, undef, 0, "<Branch>" ],
[ "/_Preferences/Color/_Red", undef, \&menuitem_cb, 0, "<RadioItem>" ],
[ "/_Preferences/Color/_Green", undef, \&menuitem_cb, 0, "/Preferences/Color/Red" ],
[ "/_Preferences/Color/_Blue", undef, \&menuitem_cb, 0, "/Preferences/Color/Red" ],
[ "/_Preferences/_Shape", undef, undef, 0, "<Branch>" ],
[ "/_Preferences/Shape/_Square", undef, \&menuitem_cb, 0, "<RadioItem>" ],
[ "/_Preferences/Shape/_Rectangle", undef, \&menuitem_cb, 0, "/Preferences/Shape/Square" ],
[ "/_Preferences/Shape/_Oval", undef, \&menuitem_cb, 0, "/Preferences/Shape/Rectangle" ],
# If you wanted this to be right justified you would use "<LastBranch>", not "<Branch>".
# Right justified help menu items are generally considered a bad idea now days.
[ "/_Help", undef, undef, 0, "<Branch>" ],
[ "/Help/_About", undef, \&menuitem_cb, 0 ],
);
sub toolbar_cb {
my ($button, $data) = @_;
my $dialog = Gtk2::MessageDialog->new ($data, 'destroy-with-parent',
'info', 'close',
"You selected a toolbar button");
# Close dialog on user response
$dialog->signal_connect (response => sub { $_[0]->destroy; 1 });
$dialog->show;
}
#
# This function registers our custom toolbar icons, so they can be themed.
#
# It's totally optional to do this, you could just manually insert icons
# and have them not be themeable, especially if you never expect people
# to theme your app.
#
my $registered = FALSE;
sub register_stock_icons {
if (!$registered) {
my @items = (
#[ "demo-gtk-logo", "_GTK!", 0, 0, undef ]
{
stock_id => "demo-gtk-logo",
label => "_GTK!",
},
);
$registered = TRUE;
# Register our stock items
Gtk2::Stock->add (@items);
# Add our custom icon factory to the list of defaults
my $factory = Gtk2::IconFactory->new;
$factory->add_default;
#
# demo_find_file() looks in the the current directory first,
# so you can run gtk-demo without installing GTK, then looks
# in the location where the file is installed.
#
my $pixbuf = undef;
### my $filename = demo_find_file ("gtk-logo-rgb.gif", undef);
my $filename = "gtk-logo-rgb.gif";
if ($filename) {
eval {
$pixbuf = Gtk2::Gdk::Pixbuf->new_from_file (
main::demo_find_file ($filename));
# The gtk-logo-rgb icon has a white background, make it transparent
my $transparent = $pixbuf->add_alpha (TRUE, 0xff, 0xff, 0xff);
my $icon_set = Gtk2::IconSet->new_from_pixbuf ($transparent);
$factory->add ("demo-gtk-logo", $icon_set);
};
warn "failed to load GTK logo for toolbar"
if $@;
}
# $factory goes out of scope here, but GTK will hold a reference on it.
}
}
sub update_statusbar {
my ($buffer, $statusbar) = @_;
$statusbar->pop (0); # clear any previous message, underflow is allowed
my $count = $buffer->get_char_count;
my $iter = $buffer->get_iter_at_mark ($buffer->get_insert);
my $row = $iter->get_line;
my $col = $iter->get_line_offset;
$statusbar->push (0, "Cursor at row $row column $col - $count chars in document");
}
sub mark_set_callback {
my ($buffer, $new_location, $mark, $data) = @_;
update_statusbar ($buffer, $data);
}
sub do {
if (!$window) {
register_stock_icons ();
#
# Create the toplevel window
#
$window = Gtk2::Window->new;
$window->set_title ("Application Window");
# NULL window variable when window is closed
$window->signal_connect (destroy => sub { $window = undef; 1 });
my $table = Gtk2::Table->new (1, 4, FALSE);
$window->add ($table);
#
# Create the menubar
#
my $accel_group = Gtk2::AccelGroup->new;
$window->add_accel_group ($accel_group);
my $item_factory = Gtk2::ItemFactory->new ("Gtk2::MenuBar", "<main>",
$accel_group);
# Set up item factory to go away with the window
$window->{'<main>'} = $item_factory;
# create menu items
$item_factory->create_items ($window, @menu_items);
$table->attach ($item_factory->get_widget ("<main>"),
# X direction Y direction
0, 1, 0, 1,
[qw/expand fill/], [],
0, 0);
#
# Create the toolbar
#
my $toolbar = Gtk2::Toolbar->new;
$toolbar->insert_stock ('gtk-open',
"This is a demo button with an 'open' icon",
undef,
\&toolbar_cb,
$window, # user data for callback
-1); # -1 means "append"
$toolbar->insert_stock ('gtk-quit',
"This is a demo button with a 'quit' icon",
undef,
\&toolbar_cb,
$window, # user data for callback
-1); # -1 means "append"
$toolbar->append_space;
$toolbar->insert_stock ("demo-gtk-logo",
"This is a demo button with a 'gtk' icon",
undef,
\&toolbar_cb,
$window, # user data for callback
-1); # -1 means "append"
$table->attach ($toolbar,
# X direction Y direction
0, 1, 1, 2,
[qw/expand fill/], [],
0, 0);
#
# Create document
#
my $sw = Gtk2::ScrolledWindow->new;
$sw->set_policy ('automatic', 'automatic');
$sw->set_shadow_type ('in');
$table->attach ($sw,
# X direction Y direction
0, 1, 2, 3,
[qw/expand fill/], [qw/expand fill/],
0, 0);
$window->set_default_size (200, 200);
my $contents = Gtk2::TextView->new;
$sw->add ($contents);
# Create statusbar
my $statusbar = Gtk2::Statusbar->new;
$table->attach ($statusbar,
# X direction Y direction
0, 1, 3, 4,
[qw/expand fill/], [],
0, 0);
# Show text widget info in the statusbar
my $buffer = $contents->get_buffer;
$buffer->signal_connect (changed => \&update_statusbar, $statusbar);
# mark-set means cursor moved
$buffer->signal_connect (mark_set => \&mark_set_callback, $statusbar);
update_statusbar ($buffer, $statusbar);
}
if (!$window->visible) {
$window->show_all;
} else {
$window->destroy;
$window = undef;
}
return $window;
}
1;
__END__
Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the
full list)
This library is free software; you can redistribute it and/or modify it under
the terms of the GNU Library General Public License as published by the Free
Software Foundation; either version 2.1 of the License, or (at your option) any
later version.
This library 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 Library General Public License for more
details.
You should have received a copy of the GNU Library General Public License along
with this library; if not, write to the Free Software Foundation, Inc., 59
Temple Place - Suite 330, Boston, MA 02111-1307 USA.