diff options
Diffstat (limited to 'perl-install')
| -rw-r--r-- | perl-install/ChangeLog | 5 | ||||
| -rw-r--r-- | perl-install/interactive.pm | 29 | ||||
| -rw-r--r-- | perl-install/interactive_gtk.pm | 16 | ||||
| -rw-r--r-- | perl-install/my_gtk.pm | 75 | ||||
| -rw-r--r-- | perl-install/printer.pm | 23 | ||||
| -rw-r--r-- | perl-install/printerdrake.pm | 11 |
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; |