example-4.pl

Developing with Gnome一书examples例子代码

#!/usr/bin/perl -w

# This program shows a preferences window, which contains
# RadioButtons, a color selection widget, and a font selection widget.
# It demonstrates the use of anonymous perl subroutines to serve as
# callbacks including using them as a method of passing extra or
# different parameters to the real callback, pops up a (modal) window
# to confirm whether the user really wants to exit, and demonstrates
# how to use pango markup.

use Glib qw(TRUE FALSE);
use Gtk2 '-init';
use Gtk2::GladeXML;
use POSIX qw(floor);

# Just to be pedantic...
use strict;
use vars qw($all_da_widgets);

sub convert_color_to_string
{
  my ($color) = @_;
  my ($color_string);

  $color_string = "#"
                  . sprintf("%.2X", floor($color->red  /256))
                  . sprintf("%.2X", floor($color->green/256))
                  . sprintf("%.2X", floor($color->blue /256));

  return $color_string;
}

sub time_to_quit
{
  my ($font_selection, $confirm_close, $warning_label, $color, $location) = @_;

  my ($color_string, $message, $replacement_text);

  # Create a color string of the form #RRGGBB, where R, G, & B are hex digits
  $color_string = &convert_color_to_string($color);

  # Get the warning message
  $message = $warning_label->get_label;

  # Set up the replacement text.
  $replacement_text = '<span '
    . 'font_desc="'  . $font_selection->get_font_name . '" '
    . 'foreground="' . $color_string                  . '">'
    . $location
    . '</span>';

  # Make the new message
  $message =~ s/to <span.*<\/span>/to $replacement_text/;

  # Update the label
  $warning_label->set_label($message);

  # Make sure the confirmation window is shown
  $confirm_close->show;
}

sub hook_up_callbacks_and_set_defaults
{
  my ($the_widgets) = @_;

  my ($preferences, $are_you_sure, $font_sel, $info_label, $location);

  # Get the preferences and confirmation windows
  $preferences  = $the_widgets->get_widget('MainWindow');
  $are_you_sure = $the_widgets->get_widget('ConfirmClose');
  $font_sel     = $the_widgets->get_widget('FontSelection');

  # First, we handle setting up defaults and connect callbacks for
  # the confirmation window.

  # Have the delete event (window close) do nothing
  $are_you_sure->signal_connect( delete_event => sub { return TRUE; } );

  # Have the cancel button hide the confirmation window
  my $cancel_button = $the_widgets->get_widget('CancelButton');
  $cancel_button->signal_connect( clicked => sub {$are_you_sure->hide;} );

  # Have the "Exit anyway" button close everything
  my $exit_button = $the_widgets->get_widget('ExitButton');
  $exit_button->signal_connect( clicked => sub {Gtk2->main_quit;} );

  # Get the warning label so we can modify it later.
  $info_label = $the_widgets->get_widget('InfoLabel');

  # Make the confirm-close window starts hidden
  $are_you_sure->hide;

  # Second, we handle setting up defaults and connect callbacks for
  # the preferences window.

  # Keep track of when the location changes
  my $here_toggle = $the_widgets->get_widget('Here');
  $here_toggle->signal_connect( toggled => 
                                sub{$location = $here_toggle->get_name;} 
                              );
  my $there_toggle = $the_widgets->get_widget('There');
  $there_toggle->signal_connect( toggled => 
                                 sub{$location = $there_toggle->get_name;} 
                               );
  # Make 'There' be the default; note this also emits the toggled signal
  $there_toggle->set_active(TRUE);

  # Get the color selection widget
  my $color_widget = $the_widgets->get_widget('ColorSelection');

  # Set the default to whatever the ColorSelection widget defaults to
  my $color = $color_widget->get_current_color;

  # Keep track of when the color changes
  $color_widget->signal_connect( color_changed => 
                                 sub {$color=$color_widget->get_current_color;}
                               );

  # Turn off the opacity slider
  $color_widget->set_has_opacity_control(FALSE);

  # Have the quit button show the confirmation window
  my $quit_button = $the_widgets->get_widget('QuitButton');
  $quit_button->signal_connect( clicked => 
    sub {
      &time_to_quit($font_sel, $are_you_sure, $info_label, $color, $location);
    }
    );

  # Have the delete event (window close) also show the confirmation window
  $preferences->signal_connect( delete_event => 
    sub {
      &time_to_quit($font_sel, $are_you_sure, $info_label, $color, $location);
      return TRUE;
    }
    );
}


  # load the interface
  $all_da_widgets = Gtk2::GladeXML->new('example-4.glade');

  # Connect all the signals to the appropriate callbacks
  &hook_up_callbacks_and_set_defaults($all_da_widgets);

  # start the event loop
  Gtk2->main;