#!/usr/bin/perl -w
# very simple run program gui using Gtk-Perl
use strict;
use Gtk;
init Gtk;
my $console = "xterm -e"; # use common terminal emulator xt
+erm for X by default.
my $history_file = $ENV{HOME}; # get users home directory where
+we store the history file.
my $use_history = 1; # if you want to use history file
+ for commands you have ran.
my $exit_on_run = 1; # exit this program after started
+ the command.
my $check_all = 0; # check history file for same ent
+ries and don't add if already found.
my @history = ("");
my (
$window,
$table,
$checkbutton,
$hseparator,
$combo,
$hbuttonbox,
$ok_button,
$cancel_button,
$current,
$tooltip,
$program,
$log,
$found
);
if ($use_history && !-e "$history_file/.perlrun_history") {
open (FILE, ">$history_file/.perlrun_history") || die("$!");
seek (FILE, 0, 0);
print FILE "\n";
close (FILE);
}
$window = new Gtk::Window('toplevel'); # new Gtk
+ window.
$table = new Gtk::Table('4', '1', '0'); # new Gtk
+ table.
$checkbutton = new Gtk::CheckButton('Open in terminal'); # new Gtk
+ check button with label.
$hseparator = new Gtk::HSeparator; # new Gtk
+ horizontal separator.
$combo = new Gtk::Combo; # new Gtk
+ Combo.
$hbuttonbox = new Gtk::HButtonBox; # new Gtk
+ horizontal button box.
$ok_button = new Gtk::Button(); # new Gtk
+ button.
$cancel_button = new Gtk::Button(); # new Gtk
+ button.
$tooltip = new Gtk::Tooltips(); # new Gtk
+ tooltips.
# main Gtk window attributes.
###
$window->signal_connect("destroy", sub { Gtk->exit( 0 ); } );
$window->set_title('what should we run...');
$window->set_position('none');
$window->set_policy('0', '1', '0');
$window->set_modal('0');
$window->set_usize('290', '87');
$window->realize;
# Gtk table attributes.
###
$table->set_row_spacings('0');
$table->set_col_spacings('0');
$window->add($table);
# Gtk check button attributes.
###
$checkbutton->set_mode('1');
$checkbutton->set_state('0');
# check if history file use is enabled and read the file into the @his
+tory array.
###
if ($use_history && -e "$history_file/.perlrun_history") {
open (FILE, "$history_file/.perlrun_history") || die("$!");
@history = reverse <FILE>;
chomp @history;
close (FILE);
}
# Gtk combo box attributes.
###
$combo->set_case_sensitive('0');
$combo->set_use_arrows('1');
if ($use_history) {
$combo->set_popdown_strings(@history);
}
# Gtk horizontal button box attributes.
###
$hbuttonbox->border_width('5');
$hbuttonbox->set_layout('spread');
$hbuttonbox->set_spacing('20');
$hbuttonbox->set_child_size('75', '25');
$hbuttonbox->set_child_ipadding('7', '0');
# Gtk ok button attributes.
###
$ok_button->signal_connect('clicked', sub { &run; });
$ok_button->label('OK');
$hbuttonbox->add($ok_button);
# Gtk cancel button attributes.
###
$cancel_button->signal_connect('clicked', sub { Gtk->exit(0); } );
$cancel_button->label('Cancel');
$hbuttonbox->add($cancel_button);
# Gtk tooltips attributes.
###
$tooltip->set_tip($checkbutton, "Check this of you want to run it usin
+g terminal.", "");
# insert everything into the table.
###
$table->attach($combo, '0', '1', '0', '1', ['expand', 'fill'], [
+], '0', '0');
$table->attach($checkbutton, '0', '1', '1', '2', ['fill'], [], '0', '0
+');
$table->attach($hseparator, '0', '1', '2', '3', ['fill'], [], '0', '0
+');
$table->attach($hbuttonbox, '0', '1', '3', '4', ['expand', 'fill', 's
+hrink'], [], '0', '0');
$window->show_all();
main Gtk;
exit(0);
# this is called when you press the OK button...
sub run {
$program = $combo->entry->get_text();
$log = $program;
if (defined $program && $program =~ /\S/) {
$program =~ s/([\n\&;#\`\-'\\\/\|"*?~<>^\(\)\[\]\{\}\$])/\\$1/g;
if ($checkbutton->active) {
$program = "$console $program";
}
$program .= "&";
if ($use_history) {
open (FILE, "+<$history_file/.perlrun_history") || die ("$!");
seek (FILE, 0, 0);
my @data = reverse <FILE>;
chomp @data;
foreach $current (@data) {
if (!$check_all) {
if ($current ne "$log") {
$found = 0;
last;
}
}
if ($current eq "$log") {
$found = 1;
last;
}
$found = 0;
}
if (!$found) {
seek (FILE, 0, 1);
print FILE "$log\n";
}
close (FILE);
}
system("$program");
if ($exit_on_run) {
Gtk->exit(0);
}
}
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.