GTM

 view release on metacpan or  search on metacpan

lib/GTM.pm  view on Meta::CPAN

package GTM;

our $VERSION = "0.6";

use common::sense;

use utf8;
use Gtk2;
use Gtk2::SimpleMenu ();
use AnyEvent;
use AnyEvent::Util;
use File::HomeDir       ();
use Gtk2::Ex::PodViewer ();
use POSIX qw(setsid _exit);

=head1 NAME

GTM - A gui frontend for the GT.M database

=head1 SYNOPSIS

   gtm 

run the gtm frontend

=head1 FILES

   ~/.gtmrc

preferences (you can source it).

=cut

BEGIN {
    use base 'Exporter';
    our @EXPORT_OK = qw(set_busy output %override save_prefs);
    our @EXPORT    = ();
}

use GTM::Run ();

our %override;

our ($gtm_version, $gtm_utf8);
our @gtm_variables = (qw/gtm_dist gtmroutines gtmgbldir gtm_log gtm_chset gtm_icu_version/);

our %win_size;

sub win_size ($$;$$) {
    my ($w, $n, $x, $y) = @_;

    unless (exists $win_size{$n}) {
        $win_size{$n} = [ $x || 960, $y || 600 ];

    }
    $w->signal_connect (
        size_allocate => sub {
            $win_size{$n} = [ $_[1]->width, $_[1]->height ];
        }
    );
    $w->resize (@{$win_size{$n}});

}

my $main_window;

sub error_dialog ($@) {
    my ($parent, @data) = @_;
    my $dialog = new Gtk2::Dialog ("Program Error, \$\@ exception raised.", $parent, 'modal', OK => 42);
    win_size ($dialog, "error_dialog", 670, 320);
    $dialog->set_default_response (42);
    my $sa = new_scrolled_textarea ();
    $sa->set_size_request (660, 300);
    scrollarea_output ($sa, join "", @data);
    $dialog->vbox->add ($sa);
    $dialog->show_all;
    $dialog->run;
    $dialog->destroy;
}

sub gtm_doc ($$) {
    my ($parent, $file) = @_;
    my $dialog = new Gtk2::Dialog ("Documentation", $parent, 'modal', OK => 42);
    $dialog->set_default_response (42);
    my $pod = new Gtk2::Ex::PodViewer;
    my $file = findfile ("GTM/$file");
    $pod->load ($file);
    $pod->set_size_request (660, 620);
    $dialog->vbox->add ($pod);
    $dialog->show_all;
    $dialog->run;
    $dialog->destroy;

}

sub new_scrolled_textarea () {

lib/GTM.pm  view on Meta::CPAN

    _Locks => {
        item_type => '<Branch>',
        children  => [
            'Manage Locks' => {
                callback => sub {
                    gtm_locks ();
                  }
            },
        ],
    },
    _Journal => {
        item_type => '<Branch>',
        children  => [
            '_Enable\/switch Journal' => {
                callback => sub {
                    gtm_journal (1);
                  }
            },
            '_Disable Journal' => {
                callback => sub {
                    gtm_journal (0);
                  }
            }
        ],
    },

    "_?" => {
             item_type => '<Branch>',
             children  => [
                           _About => {
                                      callback    => sub { about_dialog; },
                                      accelerator => 'F1',
                                     }
                         ],
            },

];
for my $x (@gtm_variables) {
    my $y = $x;
    $y =~ s/_/__/g;
    push @{$menu_tree->[3]{children}}, $y => {
                                              callback => sub { edit_environment ($x); }
                                             };
}

#$buffer->signal_connect (insert_text => sub {
#                 $tv->scroll_to_mark($end_mark, 0, 1, 0, 1);
#       }
#       );

my $main_scroll;

sub output {
    my $lines = join "", @_;
    return unless length $lines;
    scrollarea_output ($main_scroll, $lines);
}

sub gtm_run ($@) {
    set_busy (1);
    local %ENV = (%ENV, %override);
    my ($cmd, %rest) = @_;
    if (ref $cmd eq "ARRAY") {
        $cmd->[0] = "$ENV{gtm_dist}/$cmd->[0]" unless $cmd->[0] =~ m@^/@;
    } else {
        $cmd = "$ENV{gtm_dist}/$cmd" unless $cmd =~ m@^/@;
    }
    output "#" x 78 . "\n";
    output "# running: ", ref $cmd eq "ARRAY" ? join " ", @$cmd : $cmd;
    output "\n" . "#" x 78 . "\n";
    my $cv = run_cmd ($cmd, %rest);
    $cv->cb (
        sub {
            shift->recv
              and do { warn "error running cmd: $!\n"; set_busy (0); return; };
            $rest{cb}->() if exists $rest{cb};
            set_busy (0);
        }
    );
}

sub gtm_run_out (@) {
    my ($cmd, %r) = (
                     shift,
                     ">"  => sub { output (@_); },
                     "2>" => sub { output (@_); },
                     @_
                    );
    gtm_run ($cmd, %r);
}

sub get_gtm_version () {
    my $lines;
    gtm_run (
        [qw[ mumps -direct ]],
        ">"  => \$lines,
        "2>" => \$lines,
        "<"  => \"Write \$C(26)_\$ZVersion_\$C(26)_\$ZCHset_\$C(26) Halt\n",
        cb   => sub {
            output ("$lines\n");
            if ($lines =~ m/\x1a([^\x1a]+)\x1a([^\x1a]+)\x1a/ms) {
                $gtm_version = $1;
                $gtm_utf8    = 1;
                $gtm_utf8    = 0 if $2 eq "M";
                $main_window->set_title ("GT.M GUI v$VERSION ($gtm_version) UTF-8=$gtm_utf8");
            }
        }
    );
}

sub gtm_integ () {

    # gtm_run_out ([ qw[ mupip integ -full -noonline -reg * ]]);
    gtm_run_out ([qw[ mupip integ -noonline -reg * ]]);
}

sub gtm_rundown () {
    gtm_run_out ([qw[ mupip rundown /REG=* ]]);
}

sub gtm_freeze ($) {
    if ($_[0]) {
        gtm_run_out ([qw[ mupip freeze -on * ]]);
    } else {
        gtm_run_out ([qw[ mupip freeze -off * ]]);
    }
}

sub gtm_journal ($) {
    if ($_[0]) {
        gtm_run_out ([qw[ mupip SET -JOURNAL=ON,BEFORE_IMAGES -REGION * ]]);
    } else {
        gtm_run_out ([qw[ mupip SET -JOURNAL=OFF -REGION * ]]);
    }
}

sub remove_lock($$$) {

lib/GTM.pm  view on Meta::CPAN

                $box->pack_start ($b, 0, 0, 0);
                $b->show;
            }
        }
    );
}

sub gtm_locks() {
    @buttons = ();
    my $dialog = new Gtk2::Dialog ("Manage Locks", $main_window, 'modal', OK => 42);
    win_size ($dialog, "manage_locks", 200, 200);
    $dialog->set_default_response (42);
    my $button = new Gtk2::Button ("_Refresh");
    my $frame  = new Gtk2::Frame  ("Locks held");
    $frame->set_border_width (5);
    $frame->set_shadow_type  ("etched-out");
    my $vbox = new Gtk2::VBox;
    $frame->add ($vbox);
    $button->signal_connect (clicked => sub { update_locks ($vbox); });
    $dialog->vbox->pack_start ($button, 0, 0, 0);
    $dialog->vbox->pack_start ($frame,  0, 0, 0);
    update_locks ($vbox);
    $dialog->show_all;
    $dialog->run;
    $dialog->destroy;
}

$SIG{__WARN__} = sub { output @_; };

sub findfile {
    my @files = @_;
  file:
    for (@files) {
        for my $prefix (@INC, "/") {
            if (-f "$prefix/$_") {
                $_ = "$prefix/$_";
                next file;
            }
        }
        die "$_: file not found in \@INC\nINC=" . join ("\n", @INC);
    }
    wantarray ? @files : $files[0];
}

our $button;

sub new () {
    my $menu = new Gtk2::SimpleMenu (menu_tree => $menu_tree);
    $main_scroll = new_scrolled_textarea();
    $main_window = new Gtk2::Window ('toplevel');
    $main_window->signal_connect (destroy => sub { main_quit Gtk2; });
    win_size ($main_window, "main_window", 960, 600);
    my $v = new Gtk2::VBox;
    $v->pack_start ($menu->{widget}, 0, 0, 0);
    $v->pack_start ($button,         0, 0, 0);

    $v->add                       ($main_scroll);
    $main_window->add             ($v);
    $main_window->add_accel_group ($menu->{accel_group});
    load_prefs;
    set_busy (0);
    get_gtm_version();
    $main_window;
}

my $was_busy = 1;
my $timer;
my $counter = 0;
my ($red, $green, $off);
$button = new Gtk2::Button;
$green  = new_from_file Gtk2::Image (findfile ("GTM/images/ampel-green.png"));
$red    = new_from_file Gtk2::Image (findfile ("GTM/images/ampel-red.png"));
$off    = new_from_file Gtk2::Image (findfile ("GTM/images/ampel-off.png"));

sub set_busy ($) {
    my $busy = shift;
    return if $was_busy == $busy;
    if ($busy == 0) {
        undef $timer;
        $button->set_image ($green);
    } else {
        $counter = 0;
        $timer = AnyEvent->timer (
            after    => 0,
            interval => .25,
            cb       => sub {
                $button->set_image (++$counter % 2 ? $red : $off);
            }
        );
    }
    $was_busy = $busy;

}

=head1 SEE ALSO

L<GTM::Run>

=head1 AUTHOR

   Stefan Traby <stefan@hello-penguin.com>
   http://oesiman.de/gt.m/

=cut

1;