path: root/perl-install/interactive/gtk.pm

package interactive::gtk; # $Id$

use diagnostics;
use strict;
use vars qw(@ISA);

@ISA = qw(interactive);

use interactive;
use common;
use ugtk2 qw(:helpers :wrappers :create);

my $forgetTime = 1000; #- in milli-seconds

sub new {
    ($::windowwidth, $::windowheight) = gtkroot()->get_size if !$::isInstall;
    goto &interactive::new;
}
sub enter_console { my ($o) = @_; $o->{suspended} = common::setVirtual(1) }
sub leave_console { my ($o) = @_; common::setVirtual(delete $o->{suspended}) }

sub exit { ugtk2::exit(@_) }

sub ask_warn {
    local $ugtk2::pop_it = 1;
    &interactive::ask_warn;
}

sub ask_fileW {
    my ($_o, $title, $dir) = @_;
    my $w = ugtk2->new($title);
    $dir .= '/' if $dir !~ m|/$|;
    ugtk2::_ask_file($w, $title, $dir); 
    $w->main;
}

sub create_boxradio {
    my ($e, $may_go_to_next, $changed, $double_click) = @_;

    my $boxradio = gtkpack2__(Gtk2::VBox->new(0, 0),
			      my @radios = gtkradio('', @{$e->{formatted_list}}));
    $boxradio->show;
    my $tips = Gtk2::Tooltips->new;
    mapn {
	my ($txt, $w) = @_;
	$w->signal_connect(button_press_event => $double_click) if $double_click;

	$w->signal_connect(key_press_event => sub {
	    &$may_go_to_next;
	});
	$w->signal_connect(clicked => sub {
 	    ${$e->{val}} = $txt;
	    &$changed;
        });
	if ($e->{help}) {
	    gtkset_tip($tips, $w,
		       ref($e->{help}) eq 'HASH' ? $e->{help}{$txt} :
		       ref($e->{help}) eq 'CODE' ? $e->{help}($txt) : $e->{help});
	}
    } $e->{list}, \@radios;

    $boxradio, sub {
	my ($v, $full_struct) = @_;
	mapn { 
	    $_[0]->set_active($_[1] eq $v);
	    $full_struct->{focus_w} = $_[0] if $_[1] eq $v;
	} \@radios, $e->{list};
    }, $radios[0];
}

sub create_treeview_list {
    my ($e, $may_go_to_next, $changed, $double_click) = @_;
    my $curr;

    my $list = Gtk2::ListStore->new(Gtk2::GType->STRING);
    my $list_tv = Gtk2::TreeView->new_with_model($list);
    $list_tv->set_headers_visible(0);
    $list_tv->get_selection()->set_mode('browse');
    my $textcolumn = Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new(), 'text' => 0);
    $list_tv->append_column($textcolumn);
    
    my $select = sub { $list_tv->set_cursor($_[0], $textcolumn, 0) };

    my ($starting_word, $start_reg) = ('', '^');
    my $timeout;
    $list_tv->signal_connect(key_press_event => sub {
        my ($_w, $event) = @_;
	my $c = chr($event->keyval & 0xff);

	Gtk2->timeout_remove($timeout) if $timeout; $timeout = '';
	
	if ($event->keyval >= 0x100) {
	    &$may_go_to_next if member($event->keyval, (Gtk2::Gdk::Event::Key->Sym_Return, Gtk2::Gdk::Event::Key->Sym_KP_Enter));
	    $starting_word = '' if !member($event->keyval, (Gtk2::Gdk::Event::Key->Sym_Control_L, Gtk2::Gdk::Event::Key->Sym_Control_R));
	} else {
	    if (member('control-mask', @{$event->state})) {
		$c eq 's' or return 1;
		$start_reg and $start_reg = '', return 1;
		$curr++;
	    } else {
		&$may_go_to_next if $c eq ' ';

		$curr++ if $starting_word eq '' || $starting_word eq $c;
		$starting_word .= $c unless $starting_word eq $c;
	    }
	    my @l = @{$e->{formatted_list}};
	    my $word = quotemeta $starting_word;
	    my $j; for ($j = 0; $j < @l; $j++) {
		 $l[($j + $curr) % @l] =~ /$start_reg$word/i and last;
	    }
	    if ($j == @l) {
		$starting_word = '';
	    } else {
		my $path = Gtk2::TreePath->new_from_string(($j + $curr) % @l);
		$select->($path);
		$path->free;
	    }

	    $timeout = Gtk2->timeout_add($forgetTime, sub { $timeout = $starting_word = ''; 0 });
	}
	0;
    });
    $list_tv->show;

    $list->append_set([ 0 => $_ ])->free foreach @{$e->{formatted_list}};

    $list_tv->get_selection->signal_connect(changed => sub {
	my ($model, $iter) = $_[0]->get_selected;
	$model && $iter or return;
	my $row = $model->get_path_str($iter);
	$iter->free;
	${$e->{val}} = $e->{list}[$curr = $row];
	&$changed;
    });
    $list_tv->signal_connect(button_press_event => $double_click) if $double_click;

    $list_tv, sub {
	my ($v) = @_;
	eval {
	    my $nb = find_index { $_ eq $v } @{$e->{list}};
	    my ($old_path) = $list_tv->get_cursor;
	    if (!$old_path || $nb != $old_path) {
		$select->(my $path = Gtk2::TreePath->new_from_string($nb));
		$path->free;
	    }
	    $old_path->free if $old_path;
	};
    };
}

sub create_treeview_tree {
    my ($e, $may_go_to_next, $changed, $double_click, $tree_expanded) = @_;

    $tree_expanded = to_bool($tree_expanded); #- to reduce "Use of uninitialized value", especially when debugging

    my $sep = quotemeta $e->{separator};
    my $tree_model = Gtk2::TreeStore->new(Gtk2::GType->STRING, Gtk2::GType->OBJECT, Gtk2::GType->STRING);
    my $tree = Gtk2::TreeView->new_with_model($tree_model);
    $tree->get_selection->set_mode('browse');
    $tree->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
    $tree->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererPixbuf->new, 'pixbuf' => 1));
    $tree->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 2));
    $tree->set_headers_visible(0);

    my @to_unref;
    $tree->signal_connect(destroy => sub { $_->unref foreach @to_unref });
    my $build_value = sub {
	if (exists $e->{image2f}) {
	    my ($text, $image) = $e->{image2f}->($_[0]);
	    [ $text  ? (0 => $text) : (),
	      $image ? (1 => do { push @to_unref, my $img = gtkcreate_pixbuf($image); $img }) : () ];
	} else {
	    [ 0 => $_[0] ];
	}
    };

    my (%wtree, %wleaves, $size, $selected_via_click);
    my $parent; $parent = sub {
	if (my $w = $wtree{"$_[0]$e->{separator}"}) { return $w }
	my $s = '';
	foreach (split $sep, $_[0]) {
	    $wtree{"$s$_$e->{separator}"} ||= 
	      $tree_model->append_set($s ? $parent->($s) : undef, $build_value->($_));
	    $size++ if !$s;
	    $s .= "$_$e->{separator}";
	}
	$wtree{$s};
    };

    #- do some precomputing to not slowdown selection change and key press
    my (%precomp, @ordered_keys);
    mapn {
	my ($root, $leaf) = $_[0] =~ /(.*)$sep(.+)/ ? ($1, $2) : ('', $_[0]);
	my $iter = $tree_model->append_set($parent->($root), $build_value->($leaf));
	my $pathstr = $tree_model->get_path_str($iter);
	$iter->free;
	$precomp{$pathstr} = { value => $leaf, fullvalue => $_[0], listvalue => $_[1] };
	push @ordered_keys, $pathstr;
	$wleaves{$_[0]} = $pathstr;
    } $e->{formatted_list}, $e->{list};
    $_->free foreach values %wtree;
    undef %wtree;

    my $select = sub {
	my ($path_str) = @_;
	my $path = Gtk2::TreePath->new_from_string($path_str);
	$tree->expand_to_path($path);
	$path->free;
	$path = Gtk2::TreePath->new_from_string($path_str);
	$tree->set_cursor($path, undef, 0);
	$tree->scroll_to_cell($path, undef, 1, 0.5, 0);
	$path->free;
    };

    my $curr = $tree_model->get_iter_first; #- default value
    $tree->expand_all if $tree_expanded;

    $tree->get_selection->signal_connect(changed => sub {
	my ($model, $iter) = $_[0]->get_selected;
	$model && $iter or return;
	$curr->free if ref $curr;
	my $path = $tree_model->get_path($curr = $iter);
	if (!$tree_model->iter_has_child($iter)) {
	    ${$e->{val}} = $precomp{$path->to_string}{listvalue};
	    &$changed;
	} else {
	    $tree->expand_row($path, 0) if $selected_via_click;
	}
	$path->free;
    });
    my ($starting_word, $start_reg) = ('', "^");
    my $timeout;

    my $toggle = sub {
	if ($tree_model->iter_has_child($curr)) {
	    my $path = $tree_model->get_path($curr);
	    $tree->toggle_expansion($path, 0);
	    $path->free;
	} else {
	    &$may_go_to_next;
	}
    };

    $tree->signal_connect(key_press_event => sub {
        my ($_w, $event) = @_;
	$selected_via_click = 0;
	my $c = chr($event->keyval & 0xff);
	$curr or return;
	Gtk2->timeout_remove($timeout) if $timeout; $timeout = '';

	if ($event->keyval >= 0x100) {
	    &$toggle if member($event->keyval, (Gtk2::Gdk::Event::Key->Sym_Return, Gtk2::Gdk::Event::Key->Sym_KP_Enter));
	    $starting_word = '' if !member($event->keyval, (Gtk2::Gdk::Event::Key->Sym_Control_L, Gtk2::Gdk::Event::Key->Sym_Control_R));
	} else {
	    my $next;
	    if (member('control-mask', @{$event->state})) {
		$c eq "s" or return 1;
		$start_reg and $start_reg = '', return 1;
		$next = 1;
	    } else {
		&$toggle if $c eq ' ';
		$next = 1 if $starting_word eq '' || $starting_word eq $c;
		$starting_word .= $c unless $starting_word eq $c;
	    }
	    my $word = quotemeta $starting_word;
	    my ($after, $best);

	    my $currpath = $tree_model->get_path_str($curr);
	    foreach my $v (@ordered_keys) { 
		$next &&= !$after;
		$after ||= $v eq $currpath;
		if ($precomp{$v}{value} =~ /$start_reg$word/i) {
		    if ($after && !$next) {
			($best, $after) = ($v, 0);
		    } else {
			$best ||= $v;
		    }
		}
	    }

	    if (defined $best) {
		$select->($best);
	    } else {
		$starting_word = '';
	    }

	    $timeout = Gtk2->timeout_add($forgetTime, sub { $timeout = $starting_word = ''; 0 });
	}
	0;
    });
    $tree->signal_connect(button_press_event => sub {
	$selected_via_click = 1;
	&$double_click if !$tree_model->iter_has_child($curr) && $double_click;
    });

    $tree, sub {
	my $v = may_apply($e->{format}, $_[0]);
	my ($model, $iter) = $tree->get_selection->get_selected;
	$select->($wleaves{$v} || return) if !$model || $wleaves{$v} ne $model->get_path_str($iter);
	$iter->free if ref $iter;
    }, $size;
}

sub create_list {
    my ($e, $may_go_to_next, $changed, $double_click) = @_;
    my $l = $e->{list};
    my $list = Gtk2::List->new;
    $list->set_selection_mode('browse');

    my $select = sub {
	$list->select_item($_[0]);
    };

    my $tips = Gtk2::Tooltips->new;
    each_index {
	my $item = Gtk2::ListItem->new(may_apply($e->{format}, $_));
	$item->signal_connect(key_press_event => sub {
    	    my ($_w, $event) = @_;
    	    my $c = chr($event->keyval & 0xff);
	    &$may_go_to_next if $event->keyval < 0x100 ? $c eq ' ' : $c eq "\r" || $c eq "\x8d";
    	    0;
    	});
	$list->append_items($item);
	$item->show;
	if ($e->{help}) {
	    gtkset_tip($tips, $item,
		       ref($e->{help}) eq 'HASH' ? $e->{help}{$_} :
		       ref($e->{help}) eq 'CODE' ? $e->{help}($_) : $e->{help});
	}
	$item->grab_focus if ${$e->{val}} && $_ eq ${$e->{val}};
    } @$l;

    #- signal_connect'ed after append_items otherwise it is called and destroys the default value
    $list->signal_connect(select_child => sub {
	my ($_w, $row) = @_;
	${$e->{val}} = $l->[$list->child_position($row)];
	&$changed;
    });
    $list->signal_connect(button_press_event => $double_click) if $double_click;

    $list, sub { 
	my ($v) = @_;
	eval { 
	    $select->(find_index { $_ eq $v } @$l);
	};
    };
}

sub ask_fromW {
    my ($o, $common, $l, $l2) = @_;
    my $ignore = 0; #-to handle recursivity

    my $mainw = ugtk2->new($common->{title}, %$o, if__($::main_window, transient => $::main_window));
 
    #-the widgets
    my (@widgets, @widgets_always, @widgets_advanced, $advanced, $advanced_pack, $has_horiz_scroll, $has_scroll, $max_width);
    my $total_size = 0;
    my $tooltips = Gtk2::Tooltips->new;

    my $set_all = sub {
	$ignore = 1;
	$_->{set}->(${$_->{e}{val}}, $_) foreach @widgets_always, @widgets_advanced;
	$_->{real_w}->set_sensitive(!$_->{e}{disabled}()) foreach @widgets_always, @widgets_advanced;
	$mainw->{ok}->set_sensitive(!$common->{callbacks}{ok_disabled}()) if $common->{callbacks}{ok_disabled};
	$ignore = 0;t">) = @_;
    my $i;

    #- first search it in the primary partitions
    $i = 0; foreach (@{$hd->{primary}{normal}}) {
	if ($_ eq $part) {
	    will_tell_kernel($hd, del => $_);

	    splice(@{$hd->{primary}{normal}}, $i, 1);
	    %$_ = (); #- blank it

	    $hd->raw_removed($hd->{primary}{raw});
	    return 1;
	}
	$i++;
    }

    my ($first, $second, $third) = map { $_->{normal} } @{$hd->{extended} || []};
    if ($third && $first eq $part) {
	die "Can not handle removing hda5 when hda6 is not the second partition" if $second->{start} > $third->{start};
    }      

    #- otherwise search it in extended partitions
    foreach (@{$hd->{extended} || []}) {
	$_->{normal} eq $part or next;

	delete $_->{normal}; #- remove it
	remove_empty_extended($hd);
	assign_device_numbers($hd);

	will_tell_kernel($hd, del => $part);
	return 1;
    }
    0;
}

# create of partition at starting at `start', of size `size' and of type `pt_type' (nice comment, uh?)
sub add_primary {
    my ($hd, $part) = @_;

    {
	local $hd->{primary}{normal}; #- save it to fake an addition of $part, that way add_primary do not modify $hd if it fails
	push @{$hd->{primary}{normal}}, $part;
	adjust_main_extended($hd); #- verify
	$hd->raw_add($hd->{primary}{raw}, $part);
    }
    push @{$hd->{primary}{normal}}, $part; #- really do it
}

sub add_extended {
    arch() =~ /^sparc|ppc/ and die N("Extended partition not supported on this platform");

    my ($hd, $part, $extended_type) = @_;
    $extended_type =~ s/Extended_?//;

    my $e = $hd->{primary}{extended};

    if ($e && !verifyInside($part, $e)) {
	#-die "sorry, can not add outside the main extended partition" unless $::unsafe;
	my $end = $e->{start} + $e->{size};
	my $start = min($e->{start}, $part->{start});
	$end = max($end, $part->{start} + $part->{size}) - $start;

	{ #- faking a resizing of the main extended partition to test for problems
	    local $e->{start} = $start;
	    local $e->{size} = $end - $start;
	    eval { verifyPrimary($hd->{primary}) };
	    $@ and die
N("You have a hole in your partition table but I can not use it.
The only solution is to move your primary partitions to have the hole next to the extended partitions.");
	}
    }

    if ($e && $part->{start} < $e->{start}) {
	my $l = first(@{$hd->{extended}});

	#- the first is a special case, must recompute its real size
	$l->{start} = round_down($l->{normal}{start} - 1, $hd->cylinder_size);
	$l->{size} = $l->{normal}{start} + $l->{normal}{size} - $l->{start};
	my $ext = { %$l };
	unshift @{$hd->{extended}}, { pt_type => 5, raw => [ $part, $ext, {}, {} ], normal => $part, extended => $ext };
	#- size will be autocalculated :)
    } else {
	my ($ext, $ext_size) = is_empty_array_ref($hd->{extended}) ?
	  ($hd->{primary}, -1) : #- -1 size will be computed by adjust_main_extended
	  (top(@{$hd->{extended}}), $part->{size});
	my %ext = (pt_type => $extended_type || 5, start => $part->{start}, size => $ext_size);

	$hd->raw_add($ext->{raw}, \%ext);
	$ext->{extended} = \%ext;
	push @{$hd->{extended}}, { %ext, raw => [ $part, {}, {}, {} ], normal => $part };
    }
    $part->{start}++; $part->{size}--; #- let it start after the extended partition sector
    adjustStartAndEnd($hd, $part);

    adjust_main_extended($hd);
}

sub add {
    my ($hd, $part, $b_primaryOrExtended, $b_forceNoAdjust) = @_;

    get_normal_parts($hd) >= ($hd->{device} =~ /^rd/ ? 7 : $hd->{device} =~ /^(sd|ida|cciss|ataraid)/ ? 15 : 63) and cdie "maximum number of partitions handled by linux reached";

    set_isFormatted($part, 0);
    put_in_hash($part, hd2minimal_part($hd));
    $part->{start} ||= 1 if arch() !~ /^sparc/; #- starting at sector 0 is not allowed
    adjustStartAndEnd($hd, $part) unless $b_forceNoAdjust;

    my $nb_primaries = $hd->{device} =~ /^rd/ ? 3 : 1;

    if (arch() =~ /^sparc|ppc/ ||
	$b_primaryOrExtended eq 'Primary' ||
	$b_primaryOrExtended !~ /Extended/ && @{$hd->{primary}{normal} || []} < $nb_primaries) {
	eval { add_primary($hd, $part) };
	goto success if !$@;
    }
    if ($hd->hasExtended) {
	eval { add_extended($hd, $part, $b_primaryOrExtended) };
	goto success if !$@;
    }
    {
	add_primary($hd, $part);
    }
  success:
    assign_device_numbers($hd);
    will_tell_kernel($hd, add => $part);
}

# search for the next partition
sub next {
    my ($hd, $part) = @_;

    first(
	  sort { $a->{start} <=> $b->{start} }
	  grep { $_->{start} >= $part->{start} + $part->{size} }
	  get_normal_parts($hd)
	 );
}
sub next_start {
    my ($hd, $part) = @_;
    my $next = &next($hd, $part);
    $next ? $next->{start} : $hd->{totalsectors};
}

sub load {
    my ($hd, $file, $b_force) = @_;

    open(my $F, $file) or die N("Error reading file %s", $file);

    my $h;
    {
	local $/ = "\0";
	eval <$F>;
    }
    $@ and die N("Restoring from file %s failed: %s", $file, $@);

    ref($h) eq 'ARRAY' or die N("Bad backup file");

    my %h; @h{@fields2save} = @$h;

    $h{totalsectors} == $hd->{totalsectors} or $b_force or cdie "bad totalsectors";

    #- unsure we do not modify totalsectors
    local $hd->{totalsectors};

    @$hd{@fields2save} = @$h;

    delete @$_{qw(isMounted isFormatted notFormatted toFormat toFormatUnsure)} foreach get_normal_parts($hd);
    will_tell_kernel($hd, 'force_reboot'); #- just like undo, do not force write_partitions so that user can see the new partition table but can still discard it
}

sub save {
    my ($hd, $file) = @_;
    my @h = @$hd{@fields2save};
    require Data::Dumper;
    eval { output($file, Data::Dumper->Dump([\@h], ['$h']), "\0") }
      or die N("Error writing to file %s", $file);
}

1;