# Arch Perl library, Copyright (C) 2004 Mikhael Goikhman, Enno Cramer
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program 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 General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use 5.006;
use strict;
use warnings;

package ArchWay::Session;

use Glib qw(TRUE FALSE);
use Gtk2;

use Arch::Session;
use Arch::Tree;
use Arch::Changeset;
use Arch::TempFiles;

use vars qw(@WINDOWS);

# exe title is_unique name label descr
my @gui_infos = qw(
	archway  ArchWay    1  main   Main       Main-Dispatcher
	archeye  ArchEye    0  cset   Changeset  Changeset-Viewer
	archelf  ArchElf    1  tree   Tree       Project-Tree
	archmag  ArchMage   1  merge  Merge      Project-Merges
	archero  ArchHero   1  persn  Personal   Personal-Information
	archaos  ArchChaos  1  confl  Conflict   Conflict-Resolver
	archgen  ArchGenie  1  graph  Graph      Branch-Graph
	archang  ArchAngel  0  archv  Archive    Archive-Browser
	archrog  ArchRogue  1  regst  Registry   Archive-Registry
);

# name label desc
my @sub_gui_infos = qw(
	revs   Revisions  Revisions-Listing
);

my (%gui_exe_to_name, %gui_name_to_info, @gui_names);
while (
	my ($exe, $title, $is_unique, $name, $label, $descr)
		= splice(@gui_infos, 0, 6)
) {
	$descr =~ s/-/ /g;
	push @gui_names, $name;
	$gui_exe_to_name{$exe} = $name;
	$gui_name_to_info{$name} = {
		exe       => $exe,
		title     => $title,
		is_unique => $is_unique,
		name      => $name,
		label     => $label,
		descr     => $descr,
	};
}
while (
	my ($name, $label, $descr)
		= splice(@sub_gui_infos, 0, 3)
) {
	$descr =~ s/-/ /g;
	$gui_name_to_info{$name} = {
		exe       => 'archway-sub',
		title     => undef,
		is_unique => 0,
		name      => $name,
		label     => $label,
		descr     => $descr,
	};
}

# guess ssh askpass
if (! exists $ENV{SSH_ASKPASS}) {
	TRY:
	foreach my $dir (split(/:/, $ENV{PATH}), '/usr/lib/ssh') {
		foreach my $prog (qw(ssh-askpass x11-ssh-askpass)) {
			my $full_prog = "$dir/$prog";
		
			if (-x $full_prog) {
				$ENV{SSH_ASKPASS} = $full_prog;
				last TRY;
			}
		}
	}
}

# use archway provided ssh-askpass if possible
if (! exists $ENV{SSH_ASKPASS}) {
	foreach my $dir ($FindBin::Bin, '/usr/share/archway', '/usr/lib/archway') {
		my $full_prog = "$dir/archway-ssh-askpass";
		
		if (-x $full_prog) {
			$ENV{SSH_ASKPASS} = $full_prog;
			last;
		}
	}
}

sub run ($;$) {
	my $class = shift;
	my $initial_gui_name = shift;

	unless ($initial_gui_name) {
		my $exe = $0;
		$exe =~ s!.*/!!;
		$initial_gui_name = $gui_exe_to_name{$exe};
	}
	$initial_gui_name = "main" unless $gui_name_to_info{$initial_gui_name};

	$0 = "archway";  # for window resources and diagnostic purposes
	Gtk2->init;

	my $self = {
		num_main_windows => 0,
		windows_tool_checkboxes => {},
	};
	bless $self, $class;

	$self->activate_gui($initial_gui_name, @ARGV);
	die "Can't activate initial gui '$initial_gui_name', exiting\n"
		unless $self->{num_main_windows} > 0;

	Gtk2->main;
}

sub get_shared_tree ($$) {
	my $self = shift;
	my $dir = shift;
	$self->{tree} ||= Arch::Tree->new($dir, own_logs => 1);
	return $self->{tree};
}

sub get_shared_arch ($) {
	my $self = shift;
	$self->{arch} ||= Arch::Session->new;
	return $self->{arch};
}

sub activate_gui ($$;@) {
	my $self = shift;
	my $gui_name = shift || "*undefined*";

	my $method_name = "_activate_${gui_name}_gui";
	die "Unknown gui name '$gui_name'\n" unless $self->can($method_name);
	my %args = (session => $self, gui_info => $gui_name_to_info{$gui_name});
	$self->$method_name(\%args, @_);
}

sub _activate_main_gui ($$) {
	my $self = shift;
	my %args = %{shift()};

	warn "No arguments are supported yet, ignoring [@_]\n" if @_;
	$self->open_main_window(%args);
}

sub _activate_tree_gui ($$;$) {
	my $self = shift;
	my %args = %{shift()};
	my $dir = shift;

	my $tree = $self->get_shared_tree($dir);
	$self->open_main_window(%args, tree => $tree);
}

sub _activate_cset_gui ($$;$$) {
	my $self = shift;
	my %args = %{shift()};
	my @opt = @_;

	my $window = $self->open_main_window(%args);

	if (! @opt) {
		ArchWay::Util::Dialogs->info(
			"Use the File menu to open a changeset."
		);

	} else {
		$window->show_string(@opt);
	}

	return $window;
}

sub _activate_merge_gui ($$;$) {
	my $self = shift;
	my %args = %{shift()};
	my $dir = shift;

	my $tree = $self->get_shared_tree($dir);
	my $arch = $self->get_shared_arch;
	$self->open_main_window(%args, tree => $tree);
}

sub _activate_persn_gui ($$) {
	my $self = shift;
	my %args = %{shift()};
	my $dir = shift;

	$self->open_main_window(%args);
}

sub _activate_confl_gui ($$) {
	my $self = shift;
	my %args = %{shift()};
	my $dir = shift;

	my $tree = $self->get_shared_tree($dir);
	$self->open_main_window(%args, tree => $tree);
}

sub _activate_graph_gui ($$) {
	my $self = shift;
	my %args = %{shift()};
	my $dir = shift;

	my $tree = $self->get_shared_tree($dir);
	$self->open_main_window(%args, tree => $tree);
}

sub _activate_archv_gui ($$$) {
	my $self = shift;
	my %args = %{shift()};
	my $limit = shift;

	my $arch = $self->get_shared_arch;
	my $window = $self->open_main_window(%args, limit => $limit);

	unless ($limit) {
		my $cb = sub {
			my $archive = shift;
			if (defined $archive) {
				$window->set_archive($archive);
			} else {
				$window->destroy;
			}
		};
		my $dialog = $self->activate_gui("regst", "--choose", "--quiet", $cb);
	}
}

sub _activate_regst_gui ($$@) {
	my $self = shift;
	my %args = %{shift()};
	my @opts = @_;

	my $is_dialog = @opts && $opts[0] =~ /^-c|--choose/ && shift @opts;
	my $is_quiet = @opts && $opts[0] =~ /^-q|--quiet/ && shift @opts;
	my $callback = @opts && ref($opts[0]) eq 'CODE' && shift @opts;
	$args{window_title} = "Please Choose Archive" if $is_dialog;

	$self->open_main_window(%args, is_dialog => $callback || $is_dialog, is_quiet => $is_quiet);
}

sub _activate_revs_gui ($$;$) {
	my $self = shift;
	my %args = %{shift()};

	$args{window_title} = shift
		if @_;

	$self->open_main_window(%args);
}

sub main_window_class ($$) {
	my $self = shift;
	my $gui_name = shift;
	my $label = $gui_name_to_info{$gui_name}->{label};
	my $window_class = "ArchWay::MainWindow::$label";
	eval "use $window_class;";
	return $@? undef: $window_class;
}

sub open_main_window ($%) {
	my $self = shift;
	my %args = @_;

	my $gui_info = $args{gui_info} || die "Internal, gui_info is not set\n";
	my $name      = $gui_info->{name};
	my $exe       = $gui_info->{exe};
	my $is_unique = $gui_info->{is_unique} && !$args{is_dialog};
	my $label     = $gui_info->{label};
	my $descr     = $gui_info->{descr};

	my $gui_status = $self->{"${name}_gui"} ||= {};
	my $window = $gui_status->{window};
	if ($is_unique && $window) {
		$window->deiconify;
		return $window;
	}

	my $window_class = $self->main_window_class($name);
	if (!$window_class) {
		warn "The $label interface is not implemented or contains errors:\n$@\n";
		return undef;
	}

	my $window_title = delete $args{window_title} || "$descr - GNU Arch GUI";
	$window = $window_class->new(%args);
	my $dialog = $window->{dialog};
	$window = $dialog if $dialog;
	$window->set_title($window_title);
	$window->set_wmclass($exe, 'ArchWay');

	$gui_status->{window} = $window if $is_unique;
	push @{$gui_status->{windows} ||= []}, $window;
	$self->{num_main_windows}++;

	# update checkboxes in tools menus of all main windows
	$self->check_tool_checkboxes($name);

	$window->signal_connect(destroy => sub {
		@WINDOWS = grep { $_ ne $window } @WINDOWS;

		$gui_status->{window} = undef if $is_unique;
		@{$gui_status->{windows}} =
			grep { $_ != $window } @{$gui_status->{windows}};

		delete $self->{windows_tool_checkboxes}->{$window};
		$self->check_tool_checkboxes($name);

		$self->{num_main_windows}--;
		Gtk2->main_quit() unless $self->{num_main_windows} > 0;
	});
	$window->show_all;

	push @WINDOWS, $window;

	return $window;
}

sub check_tool_checkboxes ($$) {
	my $self = shift;
	my $gui_name = shift;
	foreach my $window (keys %{$self->{windows_tool_checkboxes}}) {
		$self->check_tool_checkbox($window, $gui_name);
	}
}

sub check_tool_checkbox ($$$) {
	my $self = shift;
	my $window = shift;
	my $gui_name = shift;

	my @checkboxes = ();
	push @checkboxes, $self->{windows_tool_checkboxes}->{$window}->{$gui_name}
		if $window;
	push @checkboxes, $self->{main_tool_checkboxes}->{$gui_name}
		if $self->{main_tool_checkboxes};

	my $is_unique = $self->gui_info($gui_name)->{is_unique};
	my $gui_status = $self->{"${gui_name}_gui"} ||= {};
	my $has_window = @{$gui_status->{windows} ||= []};
	my $is_active = $is_unique && $has_window;
	my $is_incons = !$is_unique && $has_window;
	foreach my $checkbox (@checkboxes) {
		next unless $checkbox;
		$checkbox->set_active($is_active);
		$checkbox->set_inconsistent($is_incons);
	}
}

sub create_tools_menu ($$) {
	my $self = shift;
	my $window = shift;
	my $tool_checkboxes = $self->{windows_tool_checkboxes}->{$window} = {};

	my $menu = Gtk2::Menu->new;
#	$menu->append(Gtk2::TearoffMenuItem->new);
	foreach my $name (@gui_names) {
		my $gui_info = $gui_name_to_info{$name};
		my $descr = $gui_info->{descr};
		my $title = $gui_info->{title};

		my $menuitem = Gtk2::MenuItem->new;

		my $hbox = Gtk2::HBox->new;
		my $checkbox = Gtk2::CheckButton->new;
		$checkbox->set_sensitive(0);
		$hbox->pack_start($checkbox, FALSE, FALSE, 0);

		my $label1 = Gtk2::Label->new($descr);
		$hbox->pack_start($label1, FALSE, FALSE, 0);
		my $label2 = Gtk2::Label->new;
		$label2->set_markup("  <i>$title</i> ");
		$hbox->pack_end($label2, FALSE, FALSE, 2);

		$tool_checkboxes->{$name} = $checkbox;
		$self->check_tool_checkbox($window, $name);

		$menuitem->add($hbox);
		$menuitem->signal_connect(activate => sub {
			$self->activate_gui($name);
		});
		$menu->append($menuitem);
	}
	$menu->show_all;
	return $menu;
}

sub populate_tools_vbox ($$) {
	my $self = shift;
	my $vbox = shift || die;

	die "create_tools_box called with no existing main_gui\n"
		unless $self->{main_gui};
	die "create_tools_box called when there is one already\n"
		if $self->{main_tool_checkboxes};
	my $tool_checkboxes = $self->{main_tool_checkboxes} = {};

	foreach my $name (@gui_names) {
		my $gui_info = $gui_name_to_info{$name};
		my $descr = $gui_info->{descr};
		my $exe   = $gui_info->{exe};

		my $button = Gtk2::Button->new;

		my $hbox = Gtk2::HBox->new;
		my $checkbox = Gtk2::CheckButton->new;
		$checkbox->set_sensitive(0);
		$hbox->pack_start($checkbox, FALSE, FALSE, 0);

		my $logo_file = $self->gui_logo_file($name);
		my $image = !$logo_file || $ENV{ARCHWAY_NO_IMAGES}? undef:
			Gtk2::Image->new_from_pixbuf(
				Gtk2::Gdk::Pixbuf->new_from_file_at_size($logo_file, 60, 48)
			);
		$hbox->pack_start($image, FALSE, FALSE, 0) if $image;

		my $label1 = Gtk2::Label->new($descr);
		$hbox->pack_start($label1, FALSE, FALSE, 0);
		my $label2 = Gtk2::Label->new;
		$label2->set_markup("  <tt><b>$exe</b></tt> ");
		$hbox->pack_end($label2, FALSE, FALSE, 2);

		$tool_checkboxes->{$name} = $checkbox;
		$self->check_tool_checkbox(undef, $name);

		$button->add($hbox);
		$button->signal_connect(clicked => sub {
			$self->activate_gui($name);
		});
		$vbox->add($button);
	}
	$vbox->signal_connect(destroy => sub {
		delete $self->{main_tool_checkboxes};
	});
	$vbox->show_all;
}

sub gui_names ($) {
	return @gui_names;
}

sub gui_info ($$) {
	my $gui_name = $_[1] || die "No gui_name given";
	return $gui_name_to_info{$gui_name};
}

sub gui_logo_file ($$) {
	my $gui_name = $_[1] || die "No gui_name given";
	my $logo_name = $gui_name_to_info{$gui_name}->{exe} . ".jpg";
	my $logo_suff = "images/logo/$logo_name";
	my $logo_file = "$FindBin::Bin/../$logo_suff";
	$logo_file = "$FindBin::Bin/../share/archway/$logo_suff"
		unless -f $logo_file;
	return $logo_file;
}

# This code is simply evil ... nuff said.

# We want a reactive GUI while tla is working, so we fork off and run
# tla asynchronously.  But lacking coroutines or continuations, we
# have to nest Gtk2->main calls.  Which in itself isn't all that bad,
# unless the GUI is still enabled during the nested Gtk2->main call
# (which is exactly what we do here), because we might end up being
# called again.

# In this situation, we can't just call Gtk2->main_quit whenever a tla
# process finishes, because it would probably terminate the wrong main
# loop and we would end up with incomplete output.

# Instead we have to take a little note (@AWRT_DONE) when one of the
# outer processes finishes and only ever terminate the innermost loop
# directly.  Still, we need to quit every main loop once.  So just
# before returning from an inner run_tla call, we check if the
# containing call has already finished and terminate its main loop as
# apropriate.

# KNOWN PROBLEMS:
#   o bad interaction with quit action

use Arch::Util;
use Arch::Run;
package Arch::Util;

# detach from console if SSH_ASKPASS is set
Arch::Run::set_detach_console(exists $ENV{SSH_ASKPASS});

our @AWRT_DONE;
our $LAST_PID;

BEGIN { undef &run_cmd; undef &run_tla; }

sub run_cmd (@) {
	my $arg0 = shift || die;
	my @cmd = (split(/ /, $arg0), @_);

	my $level = @AWRT_DONE;
	push @AWRT_DONE, 0;

	# run tla process
	my ($data, $exit) = ('', undef);
	my $pid = Arch::Run::run_async(
		command => \@cmd,
		mode    => Arch::Run::RAW(),
		datacb  => sub { $data .= $_[0] },
		exitcb  => sub {
			$exit = $_[0];
			$AWRT_DONE[$level] = 1;

			# call Gtk2->main_quit for the innermost main loop only
			if ($level == $#AWRT_DONE) {
				Gtk2->main_quit;
			}
		},
	);

	$LAST_PID = $pid;

	# install timeout handler if necessary
	if ($level == 0) {
		my $break = 0;
		my $count = 0;
		
		Glib::Timeout->add(10, sub {
			# pulse progressbars
			foreach (@ArchWay::Session::WINDOWS) {
				$_->progressbar->pulse
					if $count == 0 && $_->can('progressbar');

				$count = ($count + 1) % 3;
			}

			# check fds
			Arch::Run::poll(0);

			# clear progressbars after 500ms after last pulse, if no
			# other tla process has been started by then
			if ($break) {
				Glib::Timeout->add(500, sub {
					if ($LAST_PID == $pid) {
						foreach (@ArchWay::Session::WINDOWS) {
							$_->progressbar->set_fraction(0.0)
								if $_->can('progressbar');
						}
					}
					0;
				});
			}

			!$break;
		});

		Gtk2->main;
		$break = 1;  # terminate timeout handler

	# simple inner loop
	} else {
		Gtk2->main;
	}

	pop @AWRT_DONE;

	# break next outer main loop if process finished already
	Gtk2->main_quit
		if @AWRT_DONE && $AWRT_DONE[-1];

	# does this work?
	$? = $exit;
	return wantarray ? split /\015?\012/, $data : $data;
}

sub run_tla {
	my $arg0 = shift || die "no arch subcommand\n";
	unshift @_, $Arch::Backend::EXE, split(/ /, $arg0);

	goto \&run_cmd;
}

1;
