summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>2000-04-10 14:06:56 +0000
committerFrancois Pons <fpons@mandriva.com>2000-04-10 14:06:56 +0000
commitf8ce98a9ff2c26b6b7e613e4c994382c509aa630 (patch)
tree78bdb38600e4b063e772b534a94515201c6ce701 /perl-install
parenta4e04610e2ce4e8f97805ba06bd4a02a6dac49f5 (diff)
downloaddrakx-backup-do-not-use-f8ce98a9ff2c26b6b7e613e4c994382c509aa630.tar
drakx-backup-do-not-use-f8ce98a9ff2c26b6b7e613e4c994382c509aa630.tar.gz
drakx-backup-do-not-use-f8ce98a9ff2c26b6b7e613e4c994382c509aa630.tar.bz2
drakx-backup-do-not-use-f8ce98a9ff2c26b6b7e613e4c994382c509aa630.tar.xz
drakx-backup-do-not-use-f8ce98a9ff2c26b6b7e613e4c994382c509aa630.zip
*** empty log message ***
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/ChangeLog5
-rw-r--r--perl-install/interactive.pm29
-rw-r--r--perl-install/interactive_gtk.pm16
-rw-r--r--perl-install/my_gtk.pm75
-rw-r--r--perl-install/printer.pm23
-rw-r--r--perl-install/printerdrake.pm11
6 files changed, 140 insertions, 19 deletions
diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog
index ed51b61a9..b7df29278 100644
--- a/perl-install/ChangeLog
+++ b/perl-install/ChangeLog
@@ -1,3 +1,8 @@
+2000-04-10 François Pons <fpons@mandrakesoft.com>
+
+ * interactive_gtk.pm, my_gtk.pm: added tooltips for ask_from_list,
+ which is used by printerdrake only. drops key bindings.
+
2000-04-07 François Pons <fpons@mandrakesoft.com>
* tools/serial_probe: obsoleting pnp_serial which is now replaced
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index 5d4254cc1..55abb5b23 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -113,6 +113,35 @@ sub ask_from_list2($$$$;$) {
$o->ask_from_listW($title, [ deref($message) ], $l, $def || $l->[0]);
}
+sub ask_from_list_with_help_ {
+ my ($o, $title, $message, $l, $help, $def) = @_;
+ @$l == 0 and die '';
+ @$l == 1 and return $l->[0];
+ goto &ask_from_list2_with_help_;
+}
+
+sub ask_from_list_with_help {
+ my ($o, $title, $message, $l, $help, $def) = @_;
+ @$l == 0 and die '';
+ @$l == 1 and return $l->[0];
+ goto &ask_from_list2_with_help;
+}
+
+sub ask_from_list2_with_help_($$$$$;$) {
+ my ($o, $title, $message, $l, $help, $def) = @_;
+ untranslate(
+ ask_from_list_with_help($o, $title, $message, [ map { translate($_) } @$l ], $help, translate($def)),
+ @$l);
+}
+
+sub ask_from_list2_with_help($$$$$;$) {
+ my ($o, $title, $message, $l, $help, $def) = @_;
+
+ @$l > 10 and $l = [ sort @$l ];
+
+ $o->ask_from_list_with_helpW($title, [ deref($message) ], $l, $help, $def || $l->[0]);
+}
+
sub ask_from_treelist {
my ($o, $title, $message, $separator, $l, $def) = @_;
$o->ask_from_treelistW($title, [ deref($message) ], $separator, [ sort @$l ], $def || $l->[0]);
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index 7cfc44f57..5e4764f7b 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -30,18 +30,25 @@ sub exit {
sub ask_from_listW {
my ($o, $title, $messages, $l, $def) = @_;
+ ask_from_list_with_helpW($o, $title, $messages, $l, undef, $def);
+}
+
+sub ask_from_list_with_helpW {
+ my ($o, $title, $messages, $l, $help, $def) = @_;
my $r;
my $w = my_gtk->new(first(deref($title)), %$o);
$w->{retval} = $def || $l->[0]; #- nearly especially for the X test case (see timeout in Xconfigurator.pm)
if (@$l < 5) {
my $defW;
+ my $tips = new Gtk::Tooltips;
my $f = sub { $w->{retval} = $_[1]; Gtk->main_quit };
gtkadd($w->{window},
gtkpack(create_box_with_title($w, @$messages),
gtkadd(@$l < 3 && sum(map { length $_ } @$l) < 60 ? create_hbox() : create_vbox(),
map {
my $b = new Gtk::Button($_);
+ $tips->set_tip($b, $help->{$_}) if $help && $help->{$_};
$b->signal_connect(clicked => [ $f, $_ ]);
$_ eq $def and $defW = $b;
$b;
@@ -52,7 +59,10 @@ sub ask_from_listW {
$w->{rwindow}->set_position('center') if $::isStandalone;
$r = $w->main;
} else {
- $w->_ask_from_list($title, $messages, $l, $def);
+ #- use ask_from_list_with_help only when needed, as key bindings are
+ #- dropped by List (CList does not seems to accepts Tooltips).
+ $help ? $w->_ask_from_list_with_help($title, $messages, $l, $help, $def) :
+ $w->_ask_from_list($title, $messages, $l, $def);
$r = $w->main;
}
$r or die "ask_from_list cancel";
@@ -139,11 +149,11 @@ sub ask_from_treelistW {
sub ask_many_from_list_refW {
my ($o, $title, $messages, $list, $val) = @_;
- ask_many_from_list_with_help_refW($o, $title, $messages, $list, undef, $val)
+ ask_many_from_list_with_help_refW($o, $title, $messages, undef, $list, $val)
}
sub ask_many_from_list_with_help_refW {
- my ($o, $title, $messages, $list, $help, $val) = @_;
+ my ($o, $title, $messages, $help, $list, $val) = @_;
my $w = my_gtk->new('', %$o);
my $tips = new Gtk::Tooltips;
my $box = gtkpack(new Gtk::VBox(0,0),
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index be64d842b..c1f35749e 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -531,6 +531,81 @@ sub _ask_from_list {
$list->grab_focus;
}
+sub _ask_from_list_with_help {
+ my ($o, $title, $messages, $l, $help, $def) = @_;
+ my (undef, @okcancel) = ref $title ? @$title : $title;
+ my $list = new Gtk::List();
+ my ($first_time, $starting_word, $start_reg) = (1, '', "^");
+ my (@widgets, $timeout, $curr);
+
+ my $leave = sub { $o->{retval} = $l->[$curr]; Gtk->main_quit };
+ my $select = sub {
+ $list->select_item($_[1]);
+ };
+
+ ref $title && !@okcancel ?
+ $list->signal_connect(button_release_event => $leave) :
+ $list->signal_connect(button_press_event => sub { &$leave if $_[1]{type} =~ /^2/ });
+
+ $list->signal_connect(select_child => sub {
+ my ($w, $row) = @_;
+ $curr = $list->child_position($row);
+ });
+ $list->signal_connect(key_press_event => sub {
+ my ($w, $e) = @_;
+ my $c = chr $e->{keyval};
+
+ Gtk->timeout_remove($timeout) if $timeout; $timeout = '';
+
+ if ($e->{keyval} >= 0x100) {
+ &$leave if $c eq "\r" || $c eq "\x8d";
+ $starting_word = '' if $e->{keyval} != 0xffe4; # control
+ } else {
+ if ($e->{state} & 4) {
+ #- control pressed
+ $c eq "s" or return 1;
+ $start_reg and $start_reg = '', return 1;
+ $curr++;
+ } else {
+ &$leave if $c eq ' ';
+
+ $curr++ if $starting_word eq '' || $starting_word eq $c;
+ $starting_word .= $c unless $starting_word eq $c;
+ }
+ my $word = quotemeta $starting_word;
+ my $j; for ($j = 0; $j < @$l; $j++) {
+ $l->[($j + $curr) % @$l] =~ /$start_reg$word/i and last;
+ }
+ $j == @$l ?
+ $starting_word = '' :
+ &$select(($j + $curr) % @$l);
+
+ $w->{timeout} = $timeout = Gtk->timeout_add($forgetTime, sub { $timeout = $starting_word = ''; 0 } );
+ }
+ 1;
+ });
+
+ $o->{ok_clicked} = $leave;
+ $o->{cancel_clicked} = sub { $o->destroy; die "ask_from_list cancel" }; #- make sure windows doesn't live any more.
+ gtkadd($o->{window},
+ gtkpack($o->create_box_with_title(@$messages),
+ gtkpack_(new Gtk::VBox(0,7),
+ 1, @$l > 15 ? gtkset_usize(createScrolledWindow($list), 200, min(350, $::windowheight - 60)) : $list,
+ @okcancel || !ref $title ? (0, create_okcancel($o, @okcancel)) : ())
+ ));
+ $o->show; #- otherwise the moveto is not done
+ my $tips = new Gtk::Tooltips;
+ my $toselect; map_index {
+ my $item = new Gtk::ListItem($_);
+ $list->append_items($item);
+ $tips->set_tip($item, $help->{$_}) if $help->{$_};
+ $item->show;
+ $toselect = $::i if $def && $_ eq $def;
+ } @$l;
+ &$select($toselect);
+
+ $list->grab_focus;
+}
sub _ask_warn($@) {
my ($o, @msgs) = @_;
diff --git a/perl-install/printer.pm b/perl-install/printer.pm
index f7e847b9f..66db36844 100644
--- a/perl-install/printer.pm
+++ b/perl-install/printer.pm
@@ -28,7 +28,7 @@ use strict;
=cut
#-#####################################################################################
-use vars qw(%thedb %thedb_gsdriver %printer_type %printer_type_inv $printer_type_default @papersize_type %fields $spooldir @entries_db_short @entry_db_description %descr_to_db %db_to_descr);
+use vars qw(%thedb %thedb_gsdriver %printer_type %printer_type_inv $printer_type_default @papersize_type %fields $spooldir @entries_db_short @entry_db_description %descr_to_help %descr_to_db %db_to_descr);
#-#####################################################################################
=head2 Imports
@@ -355,16 +355,16 @@ sub read_printer_db(;$) {
SWITCH: {
/GSDriver:\s*(\w*)/ and do { $entry->{GSDRIVER} = $1; last SWITCH };
/Description:\s*{(.*)}/ and do { $entry->{DESCR} = $1; last SWITCH };
- /About:\s*{(.*)}/ and do { $entry->{ABOUT} = $1; last SWITCH };
- /About:\s*{(.*)/
- and do
- {
- my $string = "$1\n";
- while (<DBPATH>) {
- /(.*)}/ and do { $entry->{ABOUT} = $string; last SWITCH };
- $string .= $_;
- }
- };
+ /About:\s*{\s*(.*?)\s*}/ and do { $entry->{ABOUT} = $1; last SWITCH };
+ /About:\s*{\s*(.*?)\s*\\\s*$/
+ and do {
+ my $string = $1;
+ while (<DBPATH>) {
+ $string =~ /\S$/ and $string .= ' ';
+ /^\s*(.*?)\s*\\\s*$/ and $string .= $1;
+ /^\s*(.*?)\s*}\s*$/ and do { $entry->{ABOUT} = $string . $1; last SWITCH };
+ }
+ };
/Resolution:\s*{(.*)}\s*{(.*)}\s*{(.*)}/
and do { push @{$entry->{RESOLUTION} ||= []}, { XDPI => $1, YDPI => $2, DESCR => $3 }; last SWITCH };
/BitsPerPixel:\s*{(.*)}\s*{(.*)}/
@@ -382,6 +382,7 @@ sub read_printer_db(;$) {
@entries_db_short = sort keys %printer::thedb;
%descr_to_db = map { $printer::thedb{$_}{DESCR}, $_ } @entries_db_short;
+ %descr_to_help = map { $printer::thedb{$_}{DESCR}, $printer::thedb{$_}{ABOUT} } @entries_db_short;
@entry_db_description = keys %descr_to_db;
%db_to_descr = reverse %descr_to_db;
}
diff --git a/perl-install/printerdrake.pm b/perl-install/printerdrake.pm
index 8901e1f0d..fd6787591 100644
--- a/perl-install/printerdrake.pm
+++ b/perl-install/printerdrake.pm
@@ -121,11 +121,12 @@ sub setup_gsdriver($$) {
do {
$printer->{DBENTRY} ||= $printer::thedb_gsdriver{$printer->{GSDRIVER}}{ENTRY};
eval { $printer->{DBENTRY} = $printer::descr_to_db{
- $in->ask_from_list_(_("Configure Printer"),
- _("What type of printer do you have?"),
- [@printer::entry_db_description],
- $printer::db_to_descr{$printer->{DBENTRY}},
- )
+ $in->ask_from_list_with_help_(_("Configure Printer"),
+ _("What type of printer do you have?"),
+ [ @printer::entry_db_description ],
+ { %printer::descr_to_help },
+ $printer::db_to_descr{$printer->{DBENTRY}},
+ )
};
}; $@ =~ /^ask_from_list cancel/ and return;