summaryrefslogtreecommitdiffstats
path: root/perl-install/unused/scsi.pm
blob: 1755ee25583e97b22829bba31d32ef7f44502cac (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
use diagnostics;
use strict;

my $scsiDeviceAvailable;
my $CSADeviceAvailable;

1;

sub scsiDeviceAvailable {
    defined $scsiDeviceAvailable and return $scsiDeviceAvailable;
    local *F;
    open F, "/proc/scsi/scsi" or log::l("failed to open /proc/scsi/scsi: $!"), return 0;
    foreach (<F>) {
	/devices: none/ and log::l("no scsi devices are available"), return $scsiDeviceAvailable = 0;
    }
    log::l("scsi devices are available");
    $scsiDeviceAvailable = 1;
}

sub CompaqSmartArrayDeviceAvailable {
    defined $CSADeviceAvailable and return $CSADeviceAvailable;
    -r "/proc/array/ida0" or log::l("failed to open /proc/array/ida0: $!"), return $CSADeviceAvailable = 0;
    log::l("Compaq Smart Array controllers available");
    $CSADeviceAvailable = 1;
}

sub scsiGetDevices {
    my @drives;
    my ($driveNum, $cdromNum, $tapeNum) = qw(0 0 0);
    my $err = sub { chop; log::l("unexpected line in /proc/scsi/scsi: $_"); error() };
    local $_;

    local *F;
    open F, "/proc/scsi/scsi" or return &$err();
    $_ = <F>; /^Attached devices:/ or return &$err();
    while ($_ = <F>) {
	my ($id) = /^Host:.*?Id: (\d+)/ or return &$err();
	$_ = <F>; my ($vendor, $model) = /^\s*Vendor:\s*(.*?)\s+Model:\s*(.*?)\s+Rev:/ or return &$err();
	$_ = <F>; my ($type) = /^\s*Type:\s*(.*)/ or &$err();
	my $device;
	if ($type =~ /Direct-Access/) {
	    $type = 'hd';
	    $device = "sd" . chr($driveNum++ + ord('a'));
	} elsif ($type =~ /Sequential-Access/) {
	    $type = 'tape';
	    $device = "st" . $tapeNum++;
	} elsif ($type =~ /CD-ROM/) {
	    $type = 'cdrom';
	    $device = "scd" . $cdromNum++;
	}
	$device and push @drives, { device => $device, type => $type, info => "$vendor $model", id => $id, bus => 0 };
    }
    [ @drives ];
}

sub ideGetDevices {
    my @idi;

    -r "/proc/ide" or die "sorry, /proc/ide not available, seems like you have a pre-2.2 kernel\n => not handled yet :(";

    #- Great. 2.2 kernel, things are much easier and less error prone.
    foreach my $d (glob_('/proc/ide/hd*')) {
	my ($t) = chomp_(cat_("$d/media"));
	my $type = ${{ disk => 'hd', cdrom => 'cdrom', tape => 'tape', floppy => 'fd' }}{$t} or next;
	my ($info) = chomp_(cat_("$d/model")); $info ||= "(none)";

	my $num = ord(($d =~ /(.)$/)[0]) - ord 'a';
	push @idi, { type => $type, device => basename($d), info => $info, bus => $num/2, id => $num%2 };
    }
    [ @idi ];
}


sub CompaqSmartArrayGetDevices {
    my @idi;
    my $f;

    for (my $i = 0; -r ($f = "/proc/array/ida$i"); $i++) {
	local *F;
	open F, $f or die;
	local $_ = <F>;
	my ($name) = m|ida/(.*?):| or next;
	push @idi, { device => $name, info => "Compaq RAID logical disk", type => 'hd' };
    }
    [ @idi ];
}

sub dac960GetDevices {
    my @idi;
    my $file = "/var/log/dmesg";
    -r $file or $file = "/tmp/syslog";

    local *F;
    open F, $file or die "Failed to open $file: $!";

    #- We are looking for lines of this format:DAC960#0:
    #- /dev/rd/c0d0: RAID-7, Online, 17928192 blocks, Write Thru0123456790123456789012
    foreach (<F>) {
	my ($devicename, $info) = m|/dev/rd/(.*?): (.*?),| or next;
	push @idi, { info => $info, type => 'hd', devicename => $devicename };
	log::l("DAC960: $devicename: $info");
    }
    [ @idi ];
}
642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906
package mygtk2;

use diagnostics;
use strict;
use lang;

our @ISA = qw(Exporter);
our @EXPORT = qw(gtknew gtkset gtkadd gtkval_register gtkval_modify);

use c;
use log;
use common;

use Gtk2;
use Gtk2::Gdk::Keysyms;

unless ($::no_ugtk_init) {
    !check_for_xserver() and print("Cannot be run in console mode.\n"), c::_exit(0);
    $::one_message_has_been_translated and warn("N() was called from $::one_message_has_been_translated BEFORE gtk2 initialisation, replace it with a N_() AND a translate() later.\n"), c::_exit(1);

    Gtk2->init;
    c::bind_textdomain_codeset($_, 'UTF8') foreach 'libDrakX', @::textdomains;
    $::need_utf8_i18n = 1;
}
Gtk2->croak_execeptions if (!$::no_ugtk_init || $::isInstall) && 0.95 < $Gtk2::VERSION;



sub gtknew {
    my $class = shift;
    if (@_ % 2 != 0) {
	internal_error("gtknew $class: bad options @_");
    }
    if (my $r = find { ref $_->[0] } group_by2(@_)) {
	internal_error("gtknew $class: $r should be a string in @_");
    }
    my %opts = @_;
    _gtk(undef, $class, 'gtknew', \%opts);
}

sub gtkset {
    my $w = shift;
    my $class = ref($w);
    if (@_ % 2 != 0) {
	internal_error("gtkset $class: bad options @_");
    }
    if (my $r = find { ref $_->[0] } group_by2(@_)) {
	internal_error("gtkset $class: $r should be a string in @_");
    }
    my %opts = @_;

    $class =~ s/^(Gtk2|Gtk2::Gdk|mygtk2)::// or internal_error("gtkset unknown class $class");
    
    _gtk($w, $class, 'gtkset', \%opts);
}

sub gtkadd {
    my $w = shift;
    my $class = ref($w);
    if (@_ % 2 != 0) {
	internal_error("gtkadd $class: bad options @_");
    }
    if (my $r = find { ref $_->[0] } group_by2(@_)) {
	internal_error("gtkadd $class: $r should be a string in @_");
    }
    my %opts = @_;
    $class =~ s/^(Gtk2|Gtk2::Gdk|mygtk2)::// or internal_error("gtkadd unknown class $class");
    
    _gtk($w, $class, 'gtkadd', \%opts);
}


my %refs;

sub gtkval_register {
    my ($w, $ref, $sub) = @_;
    push @{$w->{_ref}}, $ref;
    $w->signal_connect(destroy => sub { 
	delete $refs{$ref}{$w};
	delete $refs{$ref} if !%{$refs{$ref}};
    });
    push @{$refs{$ref}{$w}}, [ $sub, $w ];
}
sub gtkval_modify {
    my ($ref, $val, @to_skip) = @_;
    my $prev = '' . $ref;
    $$ref = $val;
    if ($prev ne '' . $ref) {
	internal_error();
    }
    foreach (map { @$_ } values %{$refs{$ref} || {}}) {	
	my ($f, @para) = @$_;
	$f->(@para) if !member($f, @to_skip);
    }
}

my $global_tooltips;

sub _gtk {
    my ($w, $class, $action, $opts) = @_;

    if (my $f = $mygtk2::{"_gtk__$class"}) {
	$w = $f->($w, $opts, $class, $action);
    } else {
	internal_error("$action $class: unknown class");
    }

    $w->set_size_request(delete $opts->{width} || -1, delete $opts->{height} || -1) if exists $opts->{width} || exists $opts->{height};
    if (my $position = delete $opts->{position}) {
	$w->set_uposition($position->[0], $position->[1]);
    }
    $w->set_name(delete $opts->{widget_name}) if exists $opts->{widget_name};
    $w->can_focus(delete $opts->{can_focus}) if exists $opts->{can_focus};
    $w->can_default(delete $opts->{can_default}) if exists $opts->{can_default};
    $w->grab_focus if delete $opts->{grab_focus};
    (delete $opts->{size_group})->add_widget($w) if $opts->{size_group};
    if (my $tip = delete $opts->{tip}) {
	$global_tooltips ||= Gtk2::Tooltips->new;
	$global_tooltips->set_tip($w, $tip);
    }

    if (%$opts && !$opts->{allow_unknown_options}) {
	internal_error("$action $class: unknown option(s) " . join(', ', keys %$opts));
    }
    $w;
}


sub _gtk__Button       { &_gtk_any_Button }
sub _gtk__ToggleButton { &_gtk_any_Button }
sub _gtk__CheckButton  { &_gtk_any_Button }
sub _gtk_any_Button {
    my ($w, $opts, $class) = @_;

    if (!$w) {
	if (!$opts->{image}) {
	    add2hash_($opts, { mnemonic => 1 });
	}
	$w = $opts->{image} ? "Gtk2::$class"->new :
	  delete $opts->{mnemonic} ? "Gtk2::$class"->new_with_mnemonic(delete $opts->{text} || '') :
	    "Gtk2::$class"->new_with_label(delete $opts->{text} || '');

	$w->{format} = delete $opts->{format} if exists $opts->{format};
    }

    if (my $image = delete $opts->{image}) {
	$w->add($image);
	$image->show;
    }
    $w->set_sensitive(delete $opts->{sensitive}) if exists $opts->{sensitive};
    $w->set_relief(delete $opts->{relief}) if exists $opts->{relief};

    if (my $text_ref = delete $opts->{text_ref}) {
	my $set = sub {
	    eval { $w->set_label(may_apply($w->{format}, $$text_ref)) };
	};
	gtkval_register($w, $text_ref, $set);
	$set->();
    } elsif (exists $opts->{text}) {
	$w->set_label(delete $opts->{text});
    }

    if ($class eq 'Button') {
	$w->signal_connect(clicked => delete $opts->{clicked}) if exists $opts->{clicked};
    } else {
	if (my $active_ref = delete $opts->{active_ref}) {
	    my $set = sub { $w->set_active($$active_ref) };
	    $w->signal_connect(toggled => sub {
		gtkval_modify($active_ref, $w->get_active, $set);
	    });
	    gtkval_register($w, $active_ref, $set);
	    gtkval_register($w, $active_ref, delete $opts->{toggled}) if exists $opts->{toggled};
	    $set->();
	} else {
	    $w->set_active(delete $opts->{active}) if exists $opts->{active};
	    $w->signal_connect(toggled => delete $opts->{toggled}) if exists $opts->{toggled};
	}
    }
    $w;
}

sub _gtk__CheckMenuItem {
    my ($w, $opts, $class) = @_;

    if (!$w) {
	add2hash_($opts, { mnemonic => 1 });

	$w = $opts->{image} || !exists $opts->{text} ? "Gtk2::$class"->new :
	  delete $opts->{mnemonic} ? "Gtk2::$class"->new_with_label(delete $opts->{text}) :
	    "Gtk2::$class"->new_with_mnemonic(delete $opts->{text});
    }

    $w->set_active(delete $opts->{active}) if exists $opts->{active};
    $w->signal_connect(toggled => delete $opts->{toggled}) if exists $opts->{toggled};
    $w;
}

sub _gtk___SpinButton {
    my ($w, $opts) = @_;

    if (!$w) {
	$opts->{adjustment} ||= do {
	    add2hash_($opts, { step_increment => 1, page_increment => 5, page_size => 1, value => delete $opts->{lower} });
	    Gtk2::Adjustment->new(delete $opts->{value}, delete $opts->{lower}, delete $opts->{upper}, delete $opts->{step_increment}, delete $opts->{page_increment}, delete $opts->{page_size});
	};
	$w = Gtk2::SpinButton->new(delete $opts->{adjustment}, delete $opts->{climb_rate} || 0, delete $opts->{digits} || 0);
    }

    $w->signal_connect(value_changed => delete $opts->{value_changed}) if exists $opts->{value_changed};
    $w;
}

sub _gtk__HScale {
    my ($w, $opts) = @_;

    if (!$w) {
	$opts->{adjustment} ||= do {
	    add2hash_($opts, { step_increment => 1, page_increment => 5, page_size => 1, value => delete $opts->{lower} });
	    Gtk2::Adjustment->new(delete $opts->{value}, delete $opts->{lower}, (delete $opts->{upper}) + 1, delete $opts->{step_increment}, delete $opts->{page_increment}, delete $opts->{page_size});
	};
	$w = Gtk2::HScale->new(delete $opts->{adjustment});
    }

    $w->signal_connect(value_changed => delete $opts->{value_changed}) if exists $opts->{value_changed};
    $w;
}

sub _gtk__VSeparator { &_gtk_any_simple }
sub _gtk__HSeparator { &_gtk_any_simple }
sub _gtk__Calendar   { &_gtk_any_simple }

sub _gtk__DrawingArea {
    my ($w, $opts) = @_;

    if (!$w) {
	$w = Gtk2::DrawingArea->new;
    }
    $w->signal_connect(expose_event => delete $opts->{expose_event}) if exists $opts->{expose_event};
    $w;
}

sub _gtk__Pixbuf {
    my ($w, $opts) = @_;

    if (!$w) {
	my $name = delete $opts->{file} or internal_error("missing file");
	my $file = _find_imgfile($name) or internal_error("can not find $name");
	$w = Gtk2::Gdk::Pixbuf->new_from_file($file);
    }
    $w;
}

sub _gtk__Image {
    my ($w, $opts, $class) = @_;

    if (!$w) {
	$w = "Gtk2::$class"->new;
	$w->{format} = delete $opts->{format} if exists $opts->{format};
    }

    if (my $name = delete $opts->{file}) {
	my $file = _find_imgfile(may_apply($w->{format}, $name)) or internal_error("can not find $name");
	$w->set_from_file($file);
    } elsif (my $file_ref = delete $opts->{file_ref}) {
	my $set = sub {
	    my $file = _find_imgfile(may_apply($w->{format}, $$file_ref)) or internal_error("can not find $$file_ref");
	    $w->set_from_file($file);
	};
	gtkval_register($w, $file_ref, $set);
	$set->();
    }
    $w;
}

sub _gtk__WrappedLabel {
    my ($w, $opts) = @_;
    
    $opts->{line_wrap} = 1;
    _gtk__Label($w, $opts);
}

sub _gtk__Label {
    my ($w, $opts) = @_;

    if ($w) {
	$w->set_text(delete $opts->{text}) if exists $opts->{text};
    } else {
	$w = exists $opts->{text} ? Gtk2::Label->new(delete $opts->{text}) : Gtk2::Label->new;
	$w->set_justify(delete $opts->{justify}) if exists $opts->{justify};
	$w->set_line_wrap(delete $opts->{line_wrap}) if exists $opts->{line_wrap};
	$w->set_alignment(@{delete $opts->{alignment}}) if exists $opts->{alignment};
	$w->modify_font(Gtk2::Pango::FontDescription->from_string(delete $opts->{font})) if exists $opts->{font};
    }

    $w->set_markup(delete $opts->{text_markup}) if exists $opts->{text_markup};
    $w;
}

sub _gtk__Entry {
    my ($w, $opts) = @_;

    if (!$w) {
	$w = Gtk2::Entry->new;
	$w->set_editable(delete $opts->{editable}) if exists $opts->{editable};
    }

    $w->set_text(delete $opts->{text}) if exists $opts->{text};
    $w->signal_connect(key_press_event => delete $opts->{key_press_event}) if exists $opts->{key_press_event};
    $w;
}

sub _gtk__TextView {
    my ($w, $opts) = @_;
	
    if (!$w) {
	$w = Gtk2::TextView->new;
	$w->set_editable(delete $opts->{editable}) if exists $opts->{editable};
	$w->set_wrap_mode(delete $opts->{wrap_mode}) if exists $opts->{wrap_mode};
	$w->set_cursor_visible(delete $opts->{cursor_visible}) if exists $opts->{cursor_visible};
    }

    _text_insert($w, delete $opts->{text}) if exists $opts->{text};
    $w;
}

sub _gtk__ComboBox {
    my ($w, $opts, $_class, $action) = @_;

    if (!$w) {
	$w = Gtk2::ComboBox->new_text;
	$w->{format} = delete $opts->{format} if exists $opts->{format};

    }
    my $set_list = sub {
	$w->{formatted_list} = $w->{format} ? [ map { $w->{format}($_) } @{$w->{list}} ] : $w->{list};
	$w->get_model->clear;
	$w->append_text($_) foreach @{$w->{formatted_list}};
    };
    if (my $list_ref = delete $opts->{list_ref}) {
	!$opts->{list} or internal_error("both list and list_ref");
	my $set = sub {
	    $w->{list} = $$list_ref;
	    $set_list->();
	};
	gtkval_register($w, $list_ref, $set);
	$set->();
    } elsif (exists $opts->{list}) {
	$w->{list} = delete $opts->{list};
	$set_list->();
    }

    if ($action eq 'gtknew') {
	if (my $text_ref = delete $opts->{text_ref}) {
	    my $set = sub {
		my $val = may_apply($w->{format}, $$text_ref);
		eval { $w->set_active(find_index { $_ eq $val } @{$w->{formatted_list}}) };
	    };
	    $w->signal_connect(changed => sub {
		gtkval_modify($text_ref, $w->{list}[$w->get_active], $set);
	    });
	    gtkval_register($w, $text_ref, $set);
	    gtkval_register($w, $text_ref, delete $opts->{changed}) if exists $opts->{changed};
	    $set->();
	} else {
	    my $val = delete $opts->{text};
	    eval { $w->set_active(find_index { $_ eq $val } @{$w->{formatted_list}}) } if defined $val;
	    $w->signal_connect(changed => delete $opts->{changed}) if exists $opts->{changed};
	}
    }
    $w;
}

sub _gtk__ScrolledWindow {
    my ($w, $opts, $_class, $action) = @_;
	
    if (!$w) {
	$w = Gtk2::ScrolledWindow->new(undef, undef);
	$w->set_policy(delete $opts->{h_policy} || 'automatic', delete $opts->{v_policy} || 'automatic');
    }

    if (my $child = delete $opts->{child}) {
	if (member(ref($child), qw(Gtk2::Layout Gtk2::Text Gtk2::TextView Gtk2::TreeView))) {
	    $w->add($child);
	} else {
	    $w->add_with_viewport($child);
	}
	$child->set_focus_vadjustment($w->get_vadjustment) if $child->can('set_focus_vadjustment');
	$child->set_left_margin(6) if ref($child) =~ /Gtk2::TextView/;
	$child->show;

	$w->child->set_shadow_type(delete $opts->{shadow_type}) if exists $opts->{shadow_type};

	if ($action eq 'gtknew' && ref($child) =~ /Gtk2::TextView|Gtk2::TreeView/) {
	    $w = gtknew('Frame', shadow_type => 'in', child => $w);
	}
    }
    $w;
}

sub _gtk__Frame {
    my ($w, $opts) = @_;

    if ($w) {
	$w->set_label(delete $opts->{text}) if exists $opts->{text};
    } else {
	$w = Gtk2::Frame->new(delete $opts->{text});
	$w->set_border_width(delete $opts->{border_width}) if exists $opts->{border_width};
	$w->set_shadow_type(delete $opts->{shadow_type}) if exists $opts->{shadow_type};
    }

    if (my $child = delete $opts->{child}) {
	$w->add($child);
	$child->show;
    }
    $w;
}

sub _gtk__Window { &_gtk_any_Window }
sub _gtk__Dialog { &_gtk_any_Window }
sub _gtk__Plug   { &_gtk_any_Window }
sub _gtk_any_Window {
    my ($w, $opts, $class) = @_;

    if (!$w) {
	if ($class eq 'Window') {
	    $w = "Gtk2::$class"->new(delete $opts->{type} || 'toplevel');
	} elsif ($class eq 'Plug') {
	    $opts->{socket_id} or internal_error("can not create a Plug without a socket_id");
	    $w = "Gtk2::$class"->new(delete $opts->{socket_id});
	} else {
	    $w = "Gtk2::$class"->new;
	}

	$w->set_modal(delete $opts->{modal}) if exists $opts->{modal};
	$w->set_transient_for(delete $opts->{transient_for}) if exists $opts->{transient_for};
	$w->set_border_width(delete $opts->{border_width}) if exists $opts->{border_width};
	$w->set_shadow_type(delete $opts->{shadow_type}) if exists $opts->{shadow_type};
	$w->set_position(delete $opts->{position_policy}) if exists $opts->{position_policy};
	my $icon_no_error = $opts->{icon_no_error};
	if (my $name = delete $opts->{icon} || delete $opts->{icon_no_error}) {
	    if (my $f = _find_imgfile($name)) {
		$w->set_icon(gtknew('Pixbuf', file => $f));
	    } elsif (!$icon_no_error) {
		internal_error("can not find $name");
	    }
	}
    }
    $w->set_title(delete $opts->{title}) if exists $opts->{title};

    if (my $child = delete $opts->{child}) {
	$w->add($child);
	$child->show;
    }
    $w;
}

sub _gtk__MagicWindow {
    my ($w, $opts) = @_;

    my $pop_it = delete $opts->{pop_it} || !$::isWizard && !$::isEmbedded || $::WizardTable && do {
	#- do not take into account the wizard banner
	any { !$_->isa('Gtk2::DrawingArea') && $_->visible } $::WizardTable->get_children;
    };

    my $sub_child = delete $opts->{child} or internal_error("missing child");

    if ($pop_it) {
	$opts->{child} = $::isInstall ?
	  gtknew('Frame', shadow_type => 'out', 
		 child => gtknew('Frame', shadow_type => 'none', border_width => 3, child => $sub_child)) :
	  $sub_child;

	$w = _create_Window($opts);
    } else {
	if (!$::WizardWindow) {

	    my $banner;
	    if (!$::isEmbedded && !$::isInstall && $::Wizard_title) {
		$banner = Gtk2::Banner->new($opts->{icon_no_error}, $::Wizard_title) or log::l("ERROR: missing wizard banner");
	    }
	    $::WizardTable = gtknew('VBox', if_($banner, children_tight => [ $banner ]));

	    if ($::isEmbedded) {
		add2hash($opts, {
		    socket_id => $::XID,
		    child => $::WizardTable,
		});
		$::Plug = $::WizardWindow = _gtk(undef, 'Plug', 'gtknew', $opts);
		sync($::WizardWindow);
	    } else {
		add2hash($opts, {
		    child => gtknew('Frame', shadow_type => 'out', child => $::WizardTable),
		});
		$::WizardWindow = _create_Window($opts);
	    }
	} else {
	    %$opts = ();
	}

	set_main_window_size($::WizardWindow);
	$sub_child->set_border_width(10);

	$w = $::WizardWindow;
	gtkadd($::WizardTable, children_loose => [ $sub_child ]);
    }
    bless { real_window => $w, child => $sub_child, pop_it => $pop_it }, 'mygtk2::MagicWindow';
}

sub _gtk__FileSelection {
    my ($w, $opts) = @_;

    if (!$w) {
	$w = Gtk2::FileSelection->new(delete $opts->{title} || '');
	gtkset($w->ok_button, %{delete $opts->{ok_button}}) if exists $opts->{ok_button};
	gtkset($w->cancel_button, %{delete $opts->{cancel_button}}) if exists $opts->{cancel_button};
    }
    $w;
}

sub _gtk__FileChooser {
    my ($w, $opts) = @_;

    #- no nice way to have a {file_ref} on a FileChooser since selection_changed only works for browsing, not file/folder creation

    if (!$w) {
	my $action = delete $opts->{action} || internal_error("missing action for FileChooser");
	$w = Gtk2::FileChooserWidget->new($action);

	my $file = $opts->{file} && delete $opts->{file};

	if (my $dir = delete $opts->{directory} || $file && dirname($file)) {
	    $w->set_current_folder($dir);
	}
	if ($file) {
	    my $meth = $action =~ /save|create/ ? 'set_current_name' : 'set_filename';
	    $w->$meth($file);
	}
    }
    $w;
}

sub _gtk__VBox { &_gtk_any_Box }
sub _gtk__HBox { &_gtk_any_Box }
sub _gtk_any_Box {
    my ($w, $opts, $class, $action) = @_;

    if (!$w) {
	$w = "Gtk2::$class"->new(0,0);
	$w->set_homogeneous(delete $opts->{homogenous}) if exists $opts->{homogenous};
	$w->set_spacing(delete $opts->{spacing}) if exists $opts->{spacing};
	$w->set_border_width(delete $opts->{border_width}) if exists $opts->{border_width};
    } elsif ($action eq 'gtkset') {
	$_->destroy foreach $w->get_children;
    }

    _gtknew_handle_children($w, $opts);
    $w;
}

sub _gtk__VButtonBox { &_gtk_any_ButtonBox }
sub _gtk__HButtonBox { &_gtk_any_ButtonBox }
sub _gtk_any_ButtonBox {
    my ($w, $opts, $class, $action) = @_;

    if (!$w) {
	$w = "Gtk2::$class"->new;
	$w->set_layout(delete $opts->{layout} || 'spread');
    } elsif ($action eq 'gtkset') {
	$_->destroy foreach $w->get_children;
    }

    _gtknew_handle_children($w, $opts);
    $w;
}

sub _gtk__Notebook {
    my ($w, $opts) = @_;

    if (!$w) {
	$w = Gtk2::Notebook->new;
	$w->set_property('show-tabs', delete $opts->{show_tabs}) if exists $opts->{show_tabs};
	$w->set_property('show-border', delete $opts->{show_border}) if exists $opts->{show_border};
    }

    if (exists $opts->{children}) {
	foreach (group_by2(@{delete $opts->{children}})) {
	    my ($title, $page) = @$_;
	    $w->append_page($page, $title);
	    $page->show;
	    $title->show;
	}
    }
    $w;
}

sub _gtk__Table {
    my ($w, $opts) = @_;

    if (!$w) {
	add2hash_($opts, { xpadding => 5, ypadding => 0, border_width => $::isInstall ? 3 : 10 });

	$w = Gtk2::Table->new(0, 0, delete $opts->{homogeneous} || 0);
	$w->set_col_spacings(delete $opts->{col_spacings} || 0);
	$w->set_row_spacings(delete $opts->{row_spacings} || 0);
	$w->set_border_width(delete $opts->{border_width});
	$w->{$_} = delete $opts->{$_} foreach 'xpadding', 'ypadding', 'mcc';
    }

    each_index {
	my ($i, $l) = ($::i, $_);
	each_index {
	    my $j = $::i;
	    if ($_) {
		ref $_ or $_ = Gtk2::WrappedLabel->new($_);
		$j != $#$l && !$w->{mcc} ?
		  $w->attach($_, $j, $j + 1, $i, $i + 1,
			     'fill', 'fill', $w->{xpadding}, $w->{ypadding}) :
			       $w->attach($_, $j, $j + 1, $i, $i + 1,
					  ['expand', 'fill'], ref($_) eq 'Gtk2::ScrolledWindow' || $_->get_data('must_grow') ? ['expand', 'fill'] : [], 0, 0);
		$_->show;
	    }
	} @$l;
    } @{delete $opts->{children} || []};

    $w;
}

sub _gtk_any_simple {
    my ($w, $_opts, $class) = @_;

    $w ||= "Gtk2::$class"->new;
}

sub _gtknew_handle_children {
    my ($w, $opts) = @_;

    my @child = exists $opts->{children_tight} ? map { [ 0, $_ ] } @{delete $opts->{children_tight}} :
                exists $opts->{children_loose} ? map { [ 1, $_ ] } @{delete $opts->{children_loose}} :
	        exists $opts->{children} ? group_by2(@{delete $opts->{children}}) : ();

    my $padding = delete $opts->{padding};

    foreach (@child) {
	my ($fill, $child) = @$_;
	$fill eq '0' || $fill eq '1' or internal_error("odd {children} parameter must be 0 or 1 (got $fill)");
	ref $child or $child = Gtk2::WrappedLabel->new($child);
	$w->pack_start($child, $fill, $fill, $padding || 0);
	$child->show;
    }
}

#- this magic function redirects method calls:
#- * default is to redirect them to the {child}
#- * if the {child} doesn't handle the method, we try with the {real_window}
#-   (eg : add_accel_group set_position set_default_size
#- * a few methods are handled specially
my %for_real_window = map { $_ => 1 } qw(show_all size_request);
sub mygtk2::MagicWindow::AUTOLOAD {
    my ($w, @args) = @_;

    my ($meth) = $mygtk2::MagicWindow::AUTOLOAD =~ /mygtk2::MagicWindow::(.*)/;

    my ($s1, $s2) = $meth eq 'show'
              ? ('real_window', 'child') :
            $meth eq 'get' && $args[0] eq 'window-position' ||
            $w->{pop_it} && ($meth eq 'destroy' || $meth eq 'hide') ||
	    $for_real_window{$meth} ||
            !$w->{child}->can($meth)
	      ? 'real_window'
	      : 'child';

#-    warn "mygtk2::MagicWindow::$meth", first($w =~ /HASH(.*)/), " on $s1 (@args)\n";

    $w->{$s2}->$meth(@args) if $s2;
    $w->{$s1}->$meth(@args);
}

sub _create_Window {
    my ($opts) = @_;

    my $no_Window_Manager = !$::isStandalone;

    add2hash($opts, {
	if_(!$::isInstall && !$::isWizard, border_width => 5),

	#- policy: during install, we need a special code to handle the weird centering, see below
	position_policy => $::isInstall ? 'none' : $no_Window_Manager ? 'center-always' : 'center-on-parent',

	if_($::isInstall, position => [
	    $::rootwidth - ($::windowwidth + $::real_windowwidth) / 2, 
	    $::logoheight + ($::windowheight - $::real_windowheight) / 2,
	]),
    });
    my $w = _gtk(undef, 'Window', 'gtknew', $opts);

    #- when the window is closed using the window manager "X" button (or alt-f4)
    $w->signal_connect(delete_event => sub { 
	if ($::isWizard) {
	    $w->destroy; 
	    die 'wizcancel';
	} else { 
	    Gtk2->main_quit;
	} 
    });

    if ($no_Window_Manager) {
	_force_keyboard_focus($w);
    }

    if ($::isInstall) {
	require install_gtk; #- for perl_checker
	install_gtk::handle_unsafe_mouse($::o, $w);
	$w->signal_connect(key_press_event => \&install_gtk::special_shortcuts);

	#- force center at a weird position, this can't be handled by position_policy
	#- because center-on-parent is a window manager hint, and we don't have a WM
	my ($wi, $he);
	$w->signal_connect(size_allocate => sub {
	    my (undef, $event) = @_;
	    my @w_size = $event->values;
	    return if $w_size[2] == $wi && $w_size[3] == $he; #BUG
	    (undef, undef, $wi, $he) = @w_size;

            $w->set_uposition(max(0, $::rootwidth - ($::windowwidth + $wi) / 2), 
			      max(0, $::logoheight + ($::windowheight - $he) / 2));
	});
	#- without this, the focus is broken during install, though this is not needed during X test, why??
	$w->show;
    }

    $w;
}

my $current_window;
sub _force_keyboard_focus {
    my ($w) = @_;

    sub _XSetInputFocus {
	my ($w) = @_;
	if ($current_window == $w) {
	    $w->window->XSetInputFocus;
	} else {
	    log::l("not XSetInputFocus since already done and not on top");
	}
	0;
    }

    #- force keyboard focus instead of mouse focus
    my $previous_current_window = $current_window;
    $current_window = $w;
    $w->signal_connect(expose_event => \&_XSetInputFocus);
    $w->signal_connect(destroy => sub { $current_window = $previous_current_window });
}

sub _find_imgfile {
    my ($name) = @_;

    if ($name =~ m|/| && -f $name) {
	$name;
    } else {
	foreach my $path (_icon_paths()) {
	    foreach ('', '.png', '.xpm') {
		my $file = "$path/$name$_";
		-f $file and return $file;
	    }
	}
    }
}

# _text_insert() can be used with any of choose one of theses styles:
# - no tags:
#   _text_insert($textview, "My text..");
# - anonymous tags:
#   _text_insert($textview, [ [ 'first text',  { 'foreground' => 'blue', 'background' => 'green', ... } ],
#			        [ 'second text' ],
#		                [ 'third', { 'font' => 'Serif 15', ... } ],
#                               ... ]);
# - named tags:
#   $textview->{tags} = {
#                        'blue_green' => { 'foreground' => 'blue', 'background' => 'green', ... },
#                        'big_font' => { 'font' => 'Serif 35', ... },
#                       }
#   _text_insert($textview, [ [ 'first text',  'blue_green' ],
#		                [ 'second', 'big_font' ],
#                               ... ]);
# - mixed anonymous and named tags:
#   $textview->{tags} = {
#                        'blue_green' => { 'foreground' => 'blue', 'background' => 'green', ... },
#                        'big_font' => { 'font' => 'Serif 35', ... },
#                       }
#   _text_insert($textview, [ [ 'first text',  'blue_green' ],
#			        [ 'second text' ],
#		                [ 'third', 'big_font' ],
#		                [ 'fourth', { 'font' => 'Serif 15', ... } ],
#                               ... ]);
sub _text_insert {
    my ($textview, $t, %opts) = @_;
    my $buffer = $textview->get_buffer;
    $buffer->{tags} ||= {};
    $buffer->{gtk_tags} ||= {};