Chris Lansdown gtk talk 13 June 2000 example3.perl
From LILUG
Note: The following attempts to use much of the original formatting that Chris Lansdown used in his handout while still working in the wikitext format!
#! /usr/bin/perl # The GPL notice would go here # This was written by Christopher Lansdown and is in the public domain
# We use the Gtk module for Gtk functionality. This corresponds to
#include <gtk/gtk.h
# in C.
use Gtk;
#When developing in perl it is always a good idea to turn on strict
# parsing. It encourages you to write good code as well as helps
# catch stupid mistakes like misspelling a variable name.
use strict;
#############################
#delcare our global variables
use vars qw(@path $cur_sel);
# Unlike C, execution of a perl program starts with the first executable
# statement. There is no special way to indicate it like with C.
###############
#initialize Gtk
init Gtk;
##############################
# Create and set up our window
my $window = new Gtk::Window('toplevel');
$window->set_title('PathOLogical - The Logical Path Editor');
$window->signal_connect('destroy', sub { Gtk::main_quit('Gtk'); });
###############
#Create our box
# We will use a veritical box this time because the list will be much taller
# than it is wide. Really tall buttons look much worse than really wide ones.
my $box = new Gtk::VBox(0, 0);
$window->add($box);
#################
#Create the Clist
my $clist = new_with_titles Gtk::CList('Directories in Path');
# Here we hook into the signals generated when a row is selected or unselected
# instead of defining an entire subroutine, we make use of perl's ability to
# generate anonymous subroutines. All that we want to do when a row is selected
# or unselected is to keep track of what the currently slected row is (gtk provides
# another way to do this, but it would be more cumbersome that to just do it
# ourselves). You will notice that we assign $cur_sel to the value of the second
# argument for a selected row (in the beginning of subroutines in perl the
# arguments are passed by an array called @_). This corresponds to the function
# prototype in C of this sort of callback as
# void cd(GtkWidget *widget, int row, gpointer data)
# For the second callback, we simply assign the arbitrary value -1 as meaning
# out of bounds since it is not a valid row number.
$clist->signal_connect('select_row', sub { $cur_sel = $_[1]; });
$clist->signal_connect('unselect_row', sub { $cur_sel = -1; });
# To compute the path that the user currently has, we simply split up the
# environment variable PATH into components separated by colons and store
# it in the array @path.
@path = split(':', $ENV{PATH});
# We now use the path to populate our list with the directories comprising
# our path.
foreach my $tmp (@path) {
$clist->append($tmp);
}
# as a quick hack, we esitamate that every row in the clist will be about 20
# pixels high and thus we set the height of the list to 20 times the number
# of elements in the path. This is a really bad way to do it but it will
# work for most people. The -1 for the first argument means that the width
# of the list should be left at it's default. A number greater than 0 would
# have set the width to that value in pixels.
$clist->set_usize(-1, 20 * scalar(@path)); #bad assupmtion
# We now set up a scrolled window and stick the list in it so that we don't
# have to do scrolling manually. This isn't a wonderful idea if the list had
# 100,000 elements, but for most applications it is fine.
my $scroll = new Gtk::ScrolledWindow(undef, undef);
$scroll->add($clist);
$box->pack_start($scroll, 1, 1, 0);
# We now set up our buttons.
# The add button is like our previous callbacks. We simply pass a function
# (subroutine) to gtk to execute when it gets the signal 'clicked'. We also
# need the subroutine to be able to manipulate the list, so we give it the
# clist widget as our private data.
my $button = new Gtk::Button('Add Directory');
$button->signal_connect('clicked', \&add_dir, $clist);
$box->pack_start($button, 0, 0, 0);
# Adding the current directory must be a special action because the current
# directory is a concept rather than a particular directory. It is normally
# represented with the character '.', so we add it to our internal path list
# as well as to the one being displayed.
$button = new Gtk::Button('Add Current Directory');
$button->signal_connect('clicked',
sub { push(@path, '.'); $clist->append('.'); });
$box->pack_start($button, 0, 0, 0);
# Removing a directory is fairly simple. Again we use an anonymous subroutine
# though we do make use of a convenience routine that we wrote to remove an
# arbitrary. element from the array
$button = new Gtk::Button('Remove Directory');
$button->signal_connect('clicked',
sub{my $sel=$cur_sel;
$clist->remove($sel);
remove(\@path,$sel)}
);
$box->pack_start($button, 0, 0, 0);
#Saving is done with a full fledged function since it is fairly complicated.
$button = new Gtk::Button('Save Path to ~/.bash_profile');
$button->signal_connect('clicked', \&write_profile);
$box->pack_start($button, 0, 0, 0);
# Like in C, we cause the window and everything in it to be displayed $window->show_all();
# And then give control to Gtk
Gtk::main('Gtk');
# This is the end of the main part of the program. Everything after this
# are simply functions made reference to above.
# This is a convenience routine to remove an arbitrary element from the array.
# It doesn't use Gtk or do anything that you would want to change so I'm not
# going to document it. If you can't figure it out email me and I will
# document it.
sub remove($$) {
my ($array, $element) = @_;
my ($i, $j);
$array->[$element] = undef;
for($i=0; $i<scalar(@$array); $i++){
if($array->[$i]){
$array->[$j]=$array->[$i]; $j++;
}
}
for($i=scalar(@$array); $i > $j; $i--) { pop @$array; }
}
# Add_dir Creates a gtk file selection widget. The file selection widget
# is a complicated widget which provides the user with a powerful way to
# select files and directories.
# We attach a function to the clicked signal of the ok button in the
# file selection dialog which adds the name of the file or directory
# selected (the second argument in the callback) to the path and the
# display. Note: we don't do anything to ensure that the user has
# actually chosen a directory. We probably should.
sub add_dir($$) {
my ($window, $clist) = @_;
my $fs = new Gtk::FileSelection("Choose a Directory");
$fs->position(-mouse);
$fs->signal_connect('delete_event', sub { destroy $fs });
$fs->cancel_button->signal_connect("clicked", sub { destroy $fs });
$fs->ok_button->signal_connect('clicked',
sub {my $fs=$_[1];
push(@path, $fs->get_filename);
$clist->append($fs->get_filename);},
$fs);
$fs->show; # once the dialog is set up, we have to tell gtk to display it.
}
# This function also doesn't use any gtk components. If you can't figure
# it out, email me.
sub write_profile ($$) {
my ($found_it, $i, $j);
# make a backup copy of the user's .bash_profile
system('cp -f ~/.bash_profile ~/.bash_profile_backup');
# This is a dumb trick to read a file into memory, I know, but it works.
my @profile = split("\n", `cat ~/.bash_profile`);
foreach my $line (@profile) {
if ($line =~ m|PATH|) {
# This is a search-and-replace regular expression. Pipes
# '|' are being used as the delimeter. The e on the end
# means treat the second part (the part to replace the first
# with) as an perl expression rather than a regular expression.
# The $1 is the string which matched everything before the word
# PATH in the line
$line =~ s|(.*)PATH(\s*)=.*|$1.'PATH="'.join(':',@path)."\"\n"|e;
$found_it=1;
}
}
if(!$found_it) {
push(@profile, "export PATH=\"" . join(':', @path) . "\"\n");
}
open(HANDLE,">$ENV{HOME}/.bash_profile") or
die "Could not open ~/.bash_profile\n";
foreach my $line (@profile) { print HANDLE "$line\n"; }
close(HANDLE);
}