ndow->{window}->add(
gtkpack_(Gtk2::VBox->new,
if_($::isEmbedded, 0, new Gtk2::Label(N("boot disk creation"))),
0, gtkadd(Gtk2::Frame->new(N("General")),
gtkpack__(new Gtk2::VBox(0, 0),
gtkpack__(new Gtk2::HBox(1, 0),
Gtk2::Label->new(N("device")),
$device_combo,
gtksignal_connect(Gtk2::Button->new(N("default")),
clicked => sub { $device_combo->entry->set_text("/dev/fd0") }),
),
gtkpack__(new Gtk2::HBox(1, 0),
Gtk2::Label->new(N("kernel version")),
$kernel_combo,
gtksignal_connect(Gtk2::Button->new("default"),
clicked => sub {
$kernel_combo->entry->set_text(chomp_(`uname -r`));
}),
),
),
),
0, gtksignal_connect(gtkset_active(Gtk2::CheckButton->new(N("Expert Mode")), $expert_mode),
clicked => \&toggle_expert_button),
1, gtkadd(my $expert_mod_frame = Gtk2::Frame->new(N("Output")),
gtkpack_(gtkset_size_request(
gtkset_border_width(
Gtk2::HBox->new(0, 0),
5),
30, 75),
1, $output = gtkset_editable(Gtk2::TextView->new, 0),
),
),
0, gtkpack__(new Gtk2::HButtonBox(),
gtksignal_connect(Gtk2::Button->new_from_stock('gtk-cancel'),
clicked => sub { ugtk2->exit(0) }
),
gtksignal_connect(Gtk2::Button->new_from_stock('gtk-preferences'), clicked => \&pref_dialog),
gtksignal_connect(gtkset_tip($tips,
Gtk2::Button->new_from_stock('gtk-ok'),
N("Build the disk")),
clicked => \&build_it
),
),
),
);
$window->{rwindow}->show_all;
$expert_mod_frame->set_sensitive($expert_mode);
$window->main;
ugtk2->exit(0);
sub toggle_expert_button() {
my ($expert_button) = @_;
$expert_mode = $expert_button->get_active;
$expert_mod_frame->set_sensitive($expert_mode);
}
my $remove_but;
sub pref_dialog() {
my $dialog = gtkset_modal(gtkset_size_request(_create_dialog(N("Advanced preferences")), 600, -1), 1);
$dialog->set_transient_for($window->{rwindow}) unless $::isEmbedded;
# Create root tree:
$tree_model = Gtk2::TreeStore->new(("Glib::String") x 2, "Glib::Int");
$tree = Gtk2::TreeView->new_with_model($tree_model);
$tree->set_headers_visible(0);
$tree->append_column(my $textcolumn = Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
$tree->signal_connect('row-expanded', \&expand_tree);
$tree->get_selection->signal_connect('changed' => \&selected_tree);
# Create modules list:
$list_model = Gtk2::ListStore->new(("Glib::String") x 3); # relative path, size, (hidden full path)
$list = Gtk2::TreeView->new_with_model($list_model);
each_index {
$list->append_column(my $col = Gtk2::TreeViewColumn->new_with_attributes($_, Gtk2::CellRendererText->new, 'text' => $::i));
$col->set_sort_column_id($::i);
$col->set_min_width((200, 50)[$::i]);
} (N("Module name"), N("Size"));
gtkpack_($dialog->vbox,
0, gtkadd(Gtk2::Frame->new(N("mkinitrd optional arguments")),
gtkpack__(Gtk2::VBox->new(0, 5),
$buttons{force} = new Gtk2::CheckButton(N("force")),
$buttons{raid} = new Gtk2::CheckButton(N("omit raid modules")),
$buttons{needed} = new Gtk2::CheckButton(N("if needed")),
$buttons{scsi} = new Gtk2::CheckButton(N("omit scsi modules")),
),
),
1, gtkadd(Gtk2::Frame->new(N("Add a module")),
create_hpaned(
gtkset_size_request(
create_scrolled_window($tree),
200, $::isEmbedded ? 0 : 175),
gtkpack_(Gtk2::VBox->new(0, 0),
1, gtkadd(Gtk2::ScrolledWindow->new,
$list
),
0, gtksignal_connect($remove_but = Gtk2::Button->new(N("Remove a module")),
clicked => sub {
my $iter = ($list->get_selection->get_selected)[1];
return unless $iter;
my $removed = $list_model->get($iter, 2);
$list_model->remove($iter);
@temp_modules = grep { $_ ne $removed } @temp_modules;
$remove_but->set_sensitive(scalar @temp_modules);
}),
),
),
),
);
# restore values:
$buttons{$_}->set_active($options{$_}) foreach keys %buttons;
fill_tree($kernel_combo->entry->get_text);
$list_model->append_set([ map_index { $::i => $_ } @$_ ]) foreach @modules;
$remove_but->set_sensitive(scalar @modules);
@temp_modules = ();
gtkpack($dialog->action_area,
gtksignal_connect(Gtk2::Button->new_from_stock('gtk-cancel'), clicked => sub { $dialog->destroy }),
gtksignal_connect(Gtk2::Button->new_from_stock('gtk-ok'), clicked => sub {
# save values:
$options{$_} = $buttons{$_}->get_active foreach keys %buttons;
my $val;
@modules = ();
$list_model->foreach(sub {
my ($model, $_path, $iter) = @_;
push @modules, [ $model->get($iter, 0), $model->get($iter, 1), $model->get($iter, 2) ];
return 0;
}, $val);
$dialog->destroy;
}),
);
$dialog->show_all;
$dialog->run;
}
#-------------------------------------------------------------
# tree functions
#-------------------------------------------------------------
### Subroutines
sub fill_tree {
my ($root_dir) = @_;
$root_dir = "/lib/modules/" . $root_dir;
# Create root tree item widget
my $parent_iter = $tree_model->append_set(undef, [ 0 => $root_dir, 1 => $root_dir, 2 => has_sub_trees($root_dir) ]);
# Create the subtree
expand_tree($tree, $parent_iter, $tree_model->get_path($parent_iter)) if has_sub_trees($root_dir);
}
# Called whenever an item is clicked on the tree widget.
sub selected_tree {
my ($select) = @_;
my ($model, $iter) = $select->get_selected;
$remove_but->set_sensitive($model && $iter);
return unless $model; # no real selection
my $file = $model->get($iter, 1);
return if -d $file;
my $size = (lstat($file))[7];
return if member($file, @temp_modules);
push @temp_modules, $file;
$list_model->append_set([ 0 => stripit($file), 1 => $size, 2 => $file ]);
}
# Callback for expanding a tree - find subdirectories, files and add them to tree
sub expand_tree {
my ($tree, $parent_iter, $path) = @_;
return if !$tree || !$parent_iter;
my $dir = $tree_model->get($parent_iter, 1);
#- if we're hinted to be expandable
if ($tree_model->get($parent_iter, 2)) {
#- hackish: if first child has '' as name, then we need to expand on the fly
if ($tree_model->iter_has_child($parent_iter)) {
my $child = $tree_model->iter_children($parent_iter);
# BUG: ->iter_children return invalid iterators !!! thus the dummy empty line
$tree_model->remove($child);
}
# do not refill the parent anymore
$tree_model->set($parent_iter, 2 => 0);
foreach my $dir_entry (all($dir)) {
my $entry_path = $dir . "/" . $dir_entry;
if (-d $entry_path || $dir_entry =~ /\.(k|)o(\.gz)?$/) {
$entry_path =~ s|//|/|g;
my $iter = $tree_model->append_set($parent_iter, [ 0 => $dir_entry, 1 => $entry_path, 2 => has_sub_trees($entry_path) ]);
#- hackery for partial displaying of trees, used in rpmdrake:
#- if leaf is void, we may create the parent and one child (to have the [+] in front of the parent in the ctree)
#- though we use '' as the label of the child; then rpmdrake will connect on tree_expand, and whenever
#- the first child has '' as the label, it will remove the child and add all the "right" children
$tree_model->append_set($iter, [ 0 => '' ]) if has_sub_trees($entry_path);
}
}
}
$tree->expand_row($path, 0);
}
#-------------------------------------------------------------
# the function
#-------------------------------------------------------------
sub build_it() {
my $co = "/sbin/mkbootdisk --noprompt --verbose --device " . $device_combo->entry->get_text;
$co .= " --mkinitrdargs -f" if $options{force};
$co .= " --mkinitrdargs --ifneeded" if $options{needed};
$co .= " --mkinitrdargs --omit-scsi-modules" if $options{scsi};
$co .= " --mkinitrdargs --omit-raid-modules" if $options{raid};
$co .= join(" --mkinitrdargs --with=", map { $_->[0] } @modules);
$co .= " " . $kernel_combo->entry->get_text;
$co .= " 2>&1 |";
warn_dialog(N("Warning"), N("Be sure a media is present for the device %s", $device_combo->entry->get_text)) or return;
# we test if the media is present
test:
my $a = "dd count=1 if=/dev/null of=" . $device_combo->entry->get_text . " 2>&1";
my $b = `$a`;
if ($b =~ /dd/) {
err_dialog(N("Error"), N("There is no medium or it is write-protected for device %s.\nPlease insert one.", $device_combo->entry->get_text), { cancel => 1 }) ? goto test : return 0;
}
local *STATUS;
open STATUS, $co or do { err_dialog(N("Error"), N("Unable to fork: %s", $!)); return };
local $_;
while (<STATUS>) {
gtktext_append($output, [ [ $_ ] ]);
}
close STATUS or err_dialog(N("Error"), N("Unable to properly close mkbootdisk: \n %s \n %s", $!, $?));
return (0);
}
####
# This is put at the end of the file because any translatable string
# appearing after this will not be found by xgettext, and so wont end in
# the pot file...
####
# Test whether a directory has subdirectories
sub has_sub_trees {
my ($dir) = @_;
foreach my $file (glob_("$dir/*")) {
return 1 if -d $file || $file =~ /\.(k|)o(\.gz)?$/;
}
return 0;
}
sub stripit {
my ($file) = @_;
$file =~ s|/lib/modules/.*?/||g;
$file;
}
