package network::adsl; # $Id$
use common;
use run_program;
use network::tools;
use network::ethernet;
use modules;
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(adsl_conf_backend);
sub get_wizard {
my ($wiz) = @_;
my $netc = $wiz->{var}{netc};
my %l = (
'pppoe' => N("use PPPoE"),
'pptp' => N("use PPTP"),
'dhcp' => N("use DHCP"),
'speedtouch' => N("Alcatel Speedtouch USB") . if_($netc->{autodetect}{adsl}{speedtouch}, N(" - detected")),
'sagem' => N("Sagem (using PPPoA) USB") . if_($netc->{autodetect}{adsl}{sagem}, N(" - detected")),
'sagem_dhcp' => N("Sagem (using DHCP) USB") . if_($netc->{autodetect}{adsl}{sagem}, N(" - detected")),
# 'eci' => N("ECI Hi-Focus"), # this one needs eci agreement
);
$wiz->{var}{adsl} = {
connection_list => \%l,
type => "",
};
add2hash($wiz->{pages},
{
adsl_old => {
name => N("Connect to the Internet") . "\n\n" .
N("The most common way to connect with adsl is pppoe.
Some connections use PPTP, a few use DHCP.
If you don't know, choose 'use PPPoE'"),
data => [
{
label => N("ADSL connection type:"), val => \$wiz->{var}{adsl}{type}, list => [ sort values %l ] },
],
pre => sub {
$wiz->{var}{adsl}{type} = $l{sagem}; # debug
$wiz->{var}{adsl}{type} ||= find { $netc->{autodetect}{adsl}{$_} } keys %l;
print "\n\ntype is �$wiz->{var}{adsl}{type}�\n\n";
},
post => sub {
$wiz->{var}{adsl}{type} = find { $l{$_} eq $wiz->{var}{adsl}{type} } keys %l;
my $adsl = $wiz->{var}{adsl}{connection};
my $type = $wiz->{var}{adsl}{type};
my $netcnx = $wiz->{var}{netcnx};
$netcnx->{type} = "adsl_$type";
$netcnx->{"adsl_$type"} = {};
$netcnx->{"adsl_$type"}{vpivci} = '' if $type =~ /eci|speedtouch/;
return 'ethernet' if $type eq 'dhcp';
adsl_probe_info($adsl, $netc, $type);
# my ($adsl, $netc, $intf, $adsl_type) = @_;
# ask_info2($adsl, $netc);
return "hw_account";
},
},
});
};
sub adsl_probe_info {
my ($adsl, $netc, $adsl_type, $o_adsl_modem) = @_;
my $pppoe_file = "$::prefix/etc/ppp/pppoe.conf";
my %pppoe_conf; %pppoe_conf = getVarsFromSh($pppoe_file) if (! defined $adsl_type || $adsl_type eq 'pppoe') && -f $pppoe_file;
my $login = $pppoe_conf{USER};
foreach (qw(/etc/ppp/peers/ppp0 /etc/ppp/options /etc/ppp/options.adsl)) {
($login) = map { if_(/^user\s+"([^"]+)"/, $1) } cat_("$::prefix/$_") if !$login && -r "$::prefix/$_";
}
my $passwd = passwd_by_login($login);
if (!$netc->{vpi} && !$netc->{vci} && member($o_adsl_modem, qw(eci speedtouch))) {
($netc->{vpi}, $netc->{vci}) =
(map { if_(/^.*-vpi\s+(\d+)\s+-vci\s+(\d+)/, map { sprintf("%x", $_) } $1, $2) } cat_("$::prefix/etc/ppp/peers/ppp0"));
}
$pppoe_conf{DNS1} ||= '';
$pppoe_conf{DNS2} ||= '';
add2hash($netc, { dnsServer2 => $pppoe_conf{DNS1}, dnsServer3 => $pppoe_conf{DNS2}, DOMAINNAME2 => '' });
add2hash($adsl, { login => $login, passwd => $passwd, passwd2 => '' });
}
sub adsl_detect() {
my $adsl = {};
require detect_devices;
($adsl->{bewan}) = detect_devices::getBewan();
($adsl->{speedtouch}) = detect_devices::getSpeedtouch();
($adsl->{sagem}) = detect_devices::getSagem();
($adsl->{eci}) = detect_devices::getECI();
return $adsl;
}
sub sagem_set_parameters {
my ($netc) = @_;
my %l = map { $_ => sprintf("%08s", $netc->{$_}) } qw(vci vpi Encapsulation);
foreach my $cfg_file (qw(/etc/analog/adiusbadsl.conf /etc/eagle-usb/eagle-usb.conf)) {
substInFile {
s/VCI=.*\n/VCI=$l{vci}\n/;
s/VPI=.*\n/VPI=$l{vpi}\n/;
s/Encapsulation=.*\n/Encapsulation=$l{Encapsulation}\n/;
s/STATIC_IP=.*\n//;
s!</eaglectrl>!STATIC_IP=$netc->{static_ip}\n</eaglectrl>! if $netc->{static_ip};
} "$::prefix$cfg_file";
}
}
sub adsl_conf_backend {
my ($in, $modules_conf, $adsl, $netc, $intf, $adsl_device, $adsl_type, $o_netcnx) = @_;
# FIXME: should not be needed:
defined $o_netcnx and $netc->{adsltype} = $o_netcnx->{type};
$netc->{adsltype} ||= "adsl_$adsl_type";
$adsl_type eq 'pptp' and $adsl_device = 'pptp_modem';
$adsl_type eq 'capi' and $adsl_device = 'capi_modem';
my $bewan_module;
$bewan_module = $o_netcnx->{bus} eq 'PCI' ? 'unicorn_pci_atm' : 'unicorn_usb_atm' if $adsl_device eq "bewan";
# all supported modems came with their own pppoa module, so no need for "plugin pppoatm.so"
my %modems = (
bewan => {
start => qq(
modprobe pppoatm
# ActivationMode=1
modprobe $bewan_module
# wait for the modem to be set up:
sleep 10
),
stop => qq(modprobe -r $bewan_module),
plugin => {
pppoa => "pppoatm.so $netc->{vpi}." . hex($netc->{vci})
},
ppp_options => qq(
lock
ipparam ppp0
default-asyncmap
hide-password
noaccomp
nobsdcomp
nodeflate
novj novjccomp
lcp-echo-interval 20
lcp-echo-failure 3
mtu 1200
mru 1200
sync
),
},
speedtouch =>
{
modules => [ qw(speedtch) ],
#- won't call pppd since we've just written ONBOOT=no, only runs modem_run
start => '/usr/bin/speedtouch-start --boot',
overide_script => 1,
server => {
pppoa => qq("/usr/sbin/pppoa3 -c")
},
plugin => {
pppoa => "pppoatm.so " . join('.', hex($netc->{vpi}), hex($netc->{vci})),
},
ppp_options => qq(
sync
noaccomp),
aliases => [
['char-major-108', 'ppp_generic'],
['tty-ldisc-3', 'ppp_async'],
['tty-ldisc-13', 'n_hdlc'],
['tty-ldisc-14', 'ppp_synctty'],
['ppp-compress-21', 'bsd_comp'],
['ppp-compress-24', 'ppp_deflate'],
['ppp-compress-26', 'ppp_deflate']
],
},
sagem =>
{
modules => [ qw(eagle-usb) ],
start => '/usr/sbin/eaglectrl -d',
stop => "/usr/bin/killall pppoa",
get_intf => "/usr/sbin/eaglectrl -i",
server => {
pppoa => q("/usr/sbin/fctStartAdsl -t 1 -i"),
},
ppp_options => qq(
mru 1492
mtu 1492
nobsdcomp
nodeflate
noaccomp -am
novjccomp),
aliases => [
['char-major-108', 'ppp_generic'],
['tty-ldisc-3', 'ppp_async'],
['tty-ldisc-13', 'n_hdlc'],
['tty-ldisc-14', 'ppp_synctty']
],
},
eci =>
{
start => '/usr/bin/startmodem',
server => {
pppoe => qq("/usr/bin/pppoeci -v 1 -vpi $netc->{vpi} -vci $netc->{vci}"),
},
ppp_options => qq(
noipdefault
sync
noaccomp
linkname eciadsl
noauth
lcp-echo-interval 0)
},
pptp_modem =>
{
server => {
pptp => qq("/usr/sbin/pptp 10.0.0.138 --nolaunchpppd"),
},
},
capi_modem =>
{
ppp_options => qq(
connect /bin/true
ipcp-accept-remote
ipcp-accept-local
sync
noauth
lcp-echo-interval 5
lcp-echo-failure 3
lcp-max-configure 50
lcp-max-terminate 2
noccp
noipx
mru 1492
mtu 1492),
plugin => {
capi => qq(capiplugin.so
avmadsl)
},
},
);
if ($adsl_type =~ /^pp|^capi$/) {
mkdir_p("$::prefix/etc/ppp");
$in->do_pkgs->install('ppp') if !$>;
my %packages = (
pppoa => [ qw(ppp-pppoatm) ],
pppoe => [ qw(ppp-pppoe rp-pppoe) ],
pptp => [ qw(pptp-linux) ],
capi => [ qw(isdn4k-utils) ], #- capi4linux service
);
$in->do_pkgs->install(@{$packages{$adsl_type}}) if !$>;
output("$::prefix/etc/ppp/options",
$adsl_device eq "bewan" ?
qq(lock
ipparam ppp0
noipdefault
noauth
default-asyncmap
defaultroute
hide-password
noaccomp
noccp
nobsdcomp
nodeflate
nopcomp
novj novjccomp
lcp-echo-interval 20
lcp-echo-failure 3
mtu 1200
mru 1200
sync
persist
user $adsl->{login}
name $adsl->{login}
usepeerdns
)
:
qq(lock
noipdefault
persist
noauth
usepeerdns
defaultroute)
);
my $pty_option = $modems{$adsl_device}{server}{$adsl_type} && "pty $modems{$adsl_device}{server}{$adsl_type}";
my $plugin = $modems{$adsl_device}{plugin}{$adsl_type} && "plugin $modems{$adsl_device}{plugin}{$adsl_type}";
my $noipdefault = $adsl_type eq 'pptp' ? '' : 'noipdefault';
output("$::prefix/etc/ppp/peers/ppp0",
qq(noauth
$noipdefault
$modems{$adsl_device}{ppp_options}
kdebug 1
nopcomp
noccp
novj
holdoff 4
maxfail 25
persist
usepeerdns
defaultroute
$pty_option
$plugin
user "$adsl->{login}"
));
write_secret_backend($adsl->{login}, $adsl->{passwd});
if ($netc->{NET_DEVICE} =~ /^eth/) {
my $net_device = $netc->{NET_DEVICE};
$intf->{$net_device} = {
DEVICE => $net_device,
BOOTPROTO => 'none',
NETMASK => '255.255.255.0',
NETWORK => '10.0.0.0',
BROADCAST => '10.0.0.255',
ONBOOT => 'yes',
};
}
if ($adsl_type eq 'pppoe') {
if (-f "$::prefix/etc/ppp/pppoe.conf") {
my $net_device = $modems{$adsl_device}{get_intf} ? "`$modems{$adsl_device}{get_intf}`" : $netc->{NET_DEVICE};
substInFile {
s/ETH=.*\n/ETH=$net_device\n/;
s/USER=.*\n/USER=$adsl->{login}\n/;
s/DNS1=.*\n/DNS1=$netc->{dnsServer2}\n/;
s/DNS2=.*\n/DNS2=$netc->{dnsServer3}\n/;
} "$::prefix/etc/ppp/pppoe.conf";
} else {
log::l("can't find pppoe.conf, make sure the rp-pppoe package is installed");
}
}
# pppoe => {
# # we do not call directly pppd, rp-pppoe take care of "plugin rp-pppoe.so" peers option and the like
# connect => "LC_ALL=C LANG=C LANGUAGE=C LC_MESSAGES=C /usr/sbin/adsl-start",
# disconnect => qq(/usr/sbin/adsl-stop
# /usr/bin/killall pppoe pppd\n),
# },
}
#- FIXME:
#- ppp0 and ippp0 are hardcoded
my $kind = $adsl_type eq 'pppoe' ? 'xDSL' : 'ADSL';
my $metric = network::tools::get_default_metric("adsl"); #- FIXME, do not override if already set
output_with_perm("$::prefix/etc/sysconfig/network-scripts/ifcfg-ppp0", 0705, qq(DEVICE=ppp0
ONBOOT=no
TYPE=$kind
METRIC=$metric
)) unless member($adsl_type, qw(manual dhcp));
#- remove file used with sagem for dhcp/static connections
unlink("$::prefix/etc/sysconfig/network-scripts/ifcfg-sagem");
#- set vpi, vci and encapsulation parameters for sagem
if ($adsl_device eq 'sagem') {
$netc->{static_ip} = $intf->{sagem}{IPADDR} if $adsl_type eq 'manual';
sagem_set_parameters($netc);
}
#- set aliases
if (exists $modems{$adsl_device}{aliases}) {
$modules_conf->set_alias($_->[0], $_->[1]) foreach @{$modems{$adsl_device}{aliases}};
$::isStandalone and $modules_conf->write;
}
#- remove the "speedtch off" alias that was written by Mandrakelinux 10.0
$adsl_device eq 'speedtouch' and $modules_conf->remove_alias('speedtch');
if ($adsl_type eq "capi") {
require network::isdn;
network::isdn::setup_capi_conf($adsl->{capi});
services::stop("isdn4linux");
services::do_not_start_service_on_boot("isdn4linux");
services::start_service_on_boot("capi4linux");
services::start("capi4linux");
#- install and run drdsl for dsl connections, once capi driver is loaded
$in->do_pkgs->ensure_is_installed_if_available("drdsl", "/usr/sbin/drdsl");
run_program::rooted($::prefix, "/usr/sbin/drdsl");
}
#- load modules and run modem-specific start programs
#- useful during install, or in case the packages have been installed after the device has been plugged
my @modules = (@{$modems{$adsl_device}{modules}}, map { $_->[1] } @{$modems{$adsl_device}{aliases}});
@modules or @modules = qw(ppp_synctty ppp_async ppp_generic n_hdlc); #- required for pppoe/pptp connections
@modules && eval { modules::load(@modules) }
or log::l("failed to load " . join(',', @modules), " modules: $@");
$modems{$adsl_device}{start} and run_program::rooted($::prefix, $modems{$adsl_device}{start});
}
1;
>241</a>
<a id='n242' href='#n242'>242</a>
<a id='n243' href='#n243'>243</a>
<a id='n244' href='#n244'>244</a>
<a id='n245' href='#n245'>245</a>
<a id='n246' href='#n246'>246</a>
<a id='n247' href='#n247'>247</a>
<a id='n248' href='#n248'>248</a>
<a id='n249' href='#n249'>249</a>
<a id='n250' href='#n250'>250</a>
<a id='n251' href='#n251'>251</a>
<a id='n252' href='#n252'>252</a>
<a id='n253' href='#n253'>253</a>
<a id='n254' href='#n254'>254</a>
<a id='n255' href='#n255'>255</a>
<a id='n256' href='#n256'>256</a>
<a id='n257' href='#n257'>257</a>
<a id='n258' href='#n258'>258</a>
<a id='n259' href='#n259'>259</a>
<a id='n260' href='#n260'>260</a>
<a id='n261' href='#n261'>261</a>
</pre></td>
<td class='lines'><pre><code><span class="hl kwa">package</span> interactive_newt<span class="hl opt">;</span> <span class="hl slc"># $Id$</span>
<span class="hl kwa">use</span> diagnostics<span class="hl opt">;</span>
<span class="hl kwa">use</span> strict<span class="hl opt">;</span>
<span class="hl kwa">use</span> vars <span class="hl str">qw(</span><span class="hl ipl">@ISA</span><span class="hl str">)</span><span class="hl opt">;</span>
<span class="hl kwb">@ISA</span> <span class="hl opt">=</span> <span class="hl str">qw(interactive)</span><span class="hl opt">;</span>
<span class="hl kwa">use</span> interactive<span class="hl opt">;</span>
<span class="hl kwa">use</span> common <span class="hl str">qw(:common :functional)</span><span class="hl opt">;</span>
<span class="hl kwa">use</span> <span class="hl kwc">log</span><span class="hl opt">;</span>
<span class="hl kwa">use</span> Newt<span class="hl opt">::</span>Newt<span class="hl opt">;</span> <span class="hl slc">#- !! provides Newt and not Newt::Newt</span>
<span class="hl kwc">my</span> <span class="hl kwb">$width</span> <span class="hl opt">=</span> <span class="hl num">80</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl kwb">$height</span> <span class="hl opt">=</span> <span class="hl num">25</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl kwb">@wait_messages</span><span class="hl opt">;</span>
<span class="hl kwa">sub</span> new<span class="hl opt">() {</span>
Newt<span class="hl opt">::</span>Init<span class="hl opt">;</span>
Newt<span class="hl opt">::</span>Cls<span class="hl opt">;</span>
Newt<span class="hl opt">::</span>SetSuspendCallback<span class="hl opt">;</span>
<span class="hl kwc">open</span> STDERR<span class="hl opt">,</span><span class="hl str">">/dev/null"</span> <span class="hl kwa">if</span> <span class="hl opt">$::</span>isStandalone<span class="hl opt">;</span>
<span class="hl kwc">bless</span> <span class="hl opt">{},</span> <span class="hl kwb">$_</span><span class="hl opt">[</span><span class="hl num">0</span><span class="hl opt">];</span>
<span class="hl opt">}</span>
<span class="hl kwa">sub</span> enter_console <span class="hl opt">{</span> Newt<span class="hl opt">::</span>Suspend <span class="hl opt">}</span>
<span class="hl kwa">sub</span> leave_console <span class="hl opt">{</span> Newt<span class="hl opt">::</span>Resume <span class="hl opt">}</span>
<span class="hl kwa">sub</span> suspend <span class="hl opt">{</span> Newt<span class="hl opt">::</span>Suspend <span class="hl opt">}</span>
<span class="hl kwa">sub</span> resume <span class="hl opt">{</span> Newt<span class="hl opt">::</span>Resume <span class="hl opt">}</span>
<span class="hl kwa">sub</span> end<span class="hl opt">() {</span> Newt<span class="hl opt">::</span>Finished <span class="hl opt">}</span>
<span class="hl kwa">sub exit</span><span class="hl opt">() {</span> end<span class="hl opt">;</span> <span class="hl kwa">exit</span><span class="hl opt">(</span><span class="hl kwb">$_</span><span class="hl opt">[</span><span class="hl num">0</span><span class="hl opt">]) }</span>
<span class="hl kwa">END</span> <span class="hl opt">{</span> end<span class="hl opt">() }</span>
<span class="hl kwa">sub</span> myTextbox <span class="hl opt">{</span>
<span class="hl kwc">my</span> <span class="hl kwb">@l</span> <span class="hl opt">=</span> <span class="hl kwc">map</span> <span class="hl opt">{</span> <span class="hl kwc">split</span> <span class="hl str">"</span><span class="hl esc">\n</span><span class="hl str">"</span> <span class="hl opt">}</span> <span class="hl kwb">@_</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl kwb">$mess</span> <span class="hl opt">=</span> Newt<span class="hl opt">::</span>Component<span class="hl opt">::</span>Textbox<span class="hl opt">(</span><span class="hl num">1</span><span class="hl opt">,</span> <span class="hl num">0</span><span class="hl opt">,</span> <span class="hl kwc">my</span> <span class="hl kwb">$w</span> <span class="hl opt">=</span> max<span class="hl opt">(</span><span class="hl kwc">map</span> <span class="hl opt">{</span> <span class="hl kwc">length</span> <span class="hl opt">}</span> <span class="hl kwb">@l</span><span class="hl opt">) +</span> <span class="hl num">1</span><span class="hl opt">,</span> <span class="hl kwc">my</span> <span class="hl kwb">$h</span> <span class="hl opt">=</span> <span class="hl kwb">@l,</span> <span class="hl num">1</span> <span class="hl opt"><<</span> <span class="hl num">6</span><span class="hl opt">);</span>
<span class="hl kwb">$mess</span><span class="hl opt">-></span><span class="hl kwd">TextboxSetText</span><span class="hl opt">(</span><span class="hl kwc">join</span><span class="hl opt">(</span><span class="hl str">"</span><span class="hl esc">\n</span><span class="hl str">"</span><span class="hl opt">,</span> <span class="hl kwb">@_</span><span class="hl opt">));</span>
<span class="hl kwb">$mess, $w</span> <span class="hl opt">+</span> <span class="hl num">1</span><span class="hl opt">,</span> <span class="hl kwb">$h</span><span class="hl opt">;</span>
<span class="hl opt">}</span>
<span class="hl kwa">sub</span> separator<span class="hl opt">(</span><span class="hl kwb">$$</span><span class="hl opt">) {</span>
<span class="hl kwc">my</span> <span class="hl kwb">$blank</span> <span class="hl opt">=</span> Newt<span class="hl opt">::</span>Component<span class="hl opt">::</span>Form<span class="hl opt">(</span>\<span class="hl kwc">undef</span><span class="hl opt">,</span> <span class="hl str">''</span><span class="hl opt">,</span> <span class="hl num">0</span><span class="hl opt">);</span>
<span class="hl kwb">$blank</span><span class="hl opt">-></span><span class="hl kwd">FormSetWidth</span> <span class="hl opt">(</span><span class="hl kwb">$_</span><span class="hl opt">[</span><span class="hl num">0</span><span class="hl opt">]);</span>
<span class="hl kwb">$blank</span><span class="hl opt">-></span><span class="hl kwd">FormSetHeight</span><span class="hl opt">(</span><span class="hl kwb">$_</span><span class="hl opt">[</span><span class="hl num">1</span><span class="hl opt">]);</span>
<span class="hl kwb">$blank</span><span class="hl opt">;</span>
<span class="hl opt">}</span>
<span class="hl kwa">sub</span> checkval<span class="hl opt">($) {</span> <span class="hl kwb">$_</span><span class="hl opt">[</span><span class="hl num">0</span><span class="hl opt">] &&</span> <span class="hl kwb">$_</span><span class="hl opt">[</span><span class="hl num">0</span><span class="hl opt">]</span> <span class="hl kwc">ne</span> <span class="hl str">' '</span> ? <span class="hl str">'*'</span> <span class="hl opt">:</span> <span class="hl str">' '</span> <span class="hl opt">}</span>
<span class="hl kwa">sub</span> ask_from_listW <span class="hl opt">{</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$o, $title_, $messages, $l, $def</span><span class="hl opt">) =</span> <span class="hl kwb">@_</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$title, @okcancel</span><span class="hl opt">) =</span> <span class="hl kwc">ref</span> <span class="hl kwb">$title_</span> ? <span class="hl kwb">@$title_</span> <span class="hl opt">: (</span><span class="hl kwb">$title_,</span> _<span class="hl opt">(</span><span class="hl str">"Ok"</span><span class="hl opt">),</span> _<span class="hl opt">(</span><span class="hl str">"Cancel"</span><span class="hl opt">));</span>
<span class="hl kwc">my</span> <span class="hl kwb">$mesg</span> <span class="hl opt">=</span> <span class="hl kwc">join</span><span class="hl opt">(</span><span class="hl str">"</span><span class="hl esc">\n</span><span class="hl str">"</span><span class="hl opt">,</span> <span class="hl kwb">@$messages</span><span class="hl opt">);</span>
<span class="hl kwc">my</span> <span class="hl kwb">$len</span> <span class="hl opt">=</span> <span class="hl num">0</span><span class="hl opt">;</span> <span class="hl kwb">$len</span> <span class="hl opt">+=</span> <span class="hl kwc">length</span><span class="hl opt">(</span><span class="hl kwb">$_</span><span class="hl opt">)</span> <span class="hl kwa">foreach</span> <span class="hl kwb">@$l</span><span class="hl opt">;</span>
<span class="hl kwa">if</span> <span class="hl opt">(</span><span class="hl kwb">@$l</span> <span class="hl opt">==</span> <span class="hl num">1</span><span class="hl opt">) {</span>
Newt<span class="hl opt">::</span>WinMessage<span class="hl opt">(</span><span class="hl kwb">$title, @$l, $mesg</span><span class="hl opt">);</span>
<span class="hl kwb">$l</span><span class="hl opt">->[</span><span class="hl num">0</span><span class="hl opt">];</span>
<span class="hl slc">#- because newt will not try to remove window if bigger than screen !</span>
<span class="hl opt">}</span> <span class="hl kwa">elsif</span> <span class="hl opt">(</span><span class="hl kwb">@$l</span> <span class="hl opt">==</span> <span class="hl num">2</span> <span class="hl opt">&&</span> <span class="hl kwb">$len</span> <span class="hl opt"><</span> <span class="hl num">64</span><span class="hl opt">) {</span>
<span class="hl kwb">$l</span><span class="hl opt">->[</span>Newt<span class="hl opt">::</span>WinChoice<span class="hl opt">(</span><span class="hl kwb">$title, @$l, $mesg</span><span class="hl opt">) -</span> <span class="hl num">1</span><span class="hl opt">];</span>
<span class="hl slc">#- because newt will not try to remove window if bigger than screen !</span>
<span class="hl opt">}</span> <span class="hl kwa">elsif</span> <span class="hl opt">(</span><span class="hl kwb">@$l</span> <span class="hl opt">==</span> <span class="hl num">3</span> <span class="hl opt">&&</span> <span class="hl kwb">$len</span> <span class="hl opt"><</span> <span class="hl num">64</span><span class="hl opt">) {</span>
<span class="hl kwb">$l</span><span class="hl opt">->[</span>Newt<span class="hl opt">::</span>WinTernary<span class="hl opt">(</span><span class="hl kwb">$title, @$l, $mesg</span><span class="hl opt">) -</span> <span class="hl num">1</span><span class="hl opt">];</span>
<span class="hl opt">}</span> <span class="hl kwa">else</span> <span class="hl opt">{</span>
<span class="hl kwc">my</span> <span class="hl kwb">$special</span> <span class="hl opt">= !</span><span class="hl kwb">@okcancel</span><span class="hl opt">;</span>
<span class="hl kwa">if</span> <span class="hl opt">(</span><span class="hl kwb">$special</span><span class="hl opt">) {</span>
<span class="hl kwb">$l</span> <span class="hl opt">= [</span> <span class="hl kwb">@$l</span> <span class="hl opt">];</span>
<span class="hl kwb">@okcancel</span> <span class="hl opt">=</span> <span class="hl kwc">pop</span> <span class="hl kwb">@$l</span><span class="hl opt">;</span>
<span class="hl opt">}</span>
<span class="hl kwc">my</span> <span class="hl kwb">$i</span><span class="hl opt">;</span> map_index <span class="hl opt">{</span> <span class="hl kwb">$i</span> <span class="hl opt">= $::</span>i <span class="hl kwa">if</span> <span class="hl kwb">$def</span> <span class="hl kwc">eq</span> <span class="hl kwb">$_</span> <span class="hl opt">}</span> <span class="hl kwb">@$l</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$r, $e</span><span class="hl opt">) =</span> Newt<span class="hl opt">::</span>WinMenu<span class="hl opt">(</span><span class="hl kwb">$title, $mesg,</span> <span class="hl num">40</span><span class="hl opt">,</span> <span class="hl num">5</span><span class="hl opt">,</span> <span class="hl num">5</span><span class="hl opt">,</span> <span class="hl num">8</span><span class="hl opt">,</span> <span class="hl kwb">$l, $i, @okcancel</span><span class="hl opt">);</span>
<span class="hl kwb">$r</span> <span class="hl opt">></span> <span class="hl num">1</span> <span class="hl kwc">and die</span> <span class="hl str">"ask_from_list cancel"</span><span class="hl opt">;</span>
<span class="hl kwa">if</span> <span class="hl opt">(</span><span class="hl kwb">$special</span><span class="hl opt">) {</span>
<span class="hl kwb">$r</span> ? <span class="hl kwb">$okcancel</span><span class="hl opt">[</span><span class="hl num">0</span><span class="hl opt">] :</span> <span class="hl kwb">$l</span><span class="hl opt">->[</span><span class="hl kwb">$e</span><span class="hl opt">];</span>
<span class="hl opt">}</span> <span class="hl kwa">else</span> <span class="hl opt">{</span>
<span class="hl kwb">$l</span><span class="hl opt">->[</span><span class="hl kwb">$e</span><span class="hl opt">];</span>
<span class="hl opt">}</span>
<span class="hl opt">}</span>
<span class="hl opt">}</span>
<span class="hl kwa">sub</span> ask_many_from_list_with_help_refW <span class="hl opt">{</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$o, $title, $messages, @lists</span><span class="hl opt">) =</span> <span class="hl kwb">@_</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$list</span><span class="hl opt">) =</span> <span class="hl kwc">map</span> <span class="hl opt">{</span> <span class="hl kwb">$_</span><span class="hl opt">->[</span><span class="hl num">0</span><span class="hl opt">] }</span> <span class="hl kwb">@lists</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$val</span><span class="hl opt">) =</span> <span class="hl kwc">map</span> <span class="hl opt">{</span> <span class="hl kwb">$_</span><span class="hl opt">->[</span><span class="hl num">2</span><span class="hl opt">] }</span> <span class="hl kwb">@lists</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl kwb">$height</span> <span class="hl opt">=</span> min<span class="hl opt">(</span><span class="hl kwc">int</span> <span class="hl kwb">@$list,</span> <span class="hl num">18</span><span class="hl opt">);</span>
<span class="hl kwc">my</span> <span class="hl kwb">$sb</span> <span class="hl opt">=</span> Newt<span class="hl opt">::</span>Component<span class="hl opt">::</span>VerticalScrollbar<span class="hl opt">(-</span><span class="hl num">1</span><span class="hl opt">, -</span><span class="hl num">1</span><span class="hl opt">,</span> <span class="hl kwb">$height,</span> <span class="hl num">9</span><span class="hl opt">,</span> <span class="hl num">10</span><span class="hl opt">);</span>
<span class="hl kwc">my</span> <span class="hl kwb">$checklist</span> <span class="hl opt">=</span> <span class="hl kwb">$sb</span><span class="hl opt">-></span><span class="hl kwd">Form</span><span class="hl opt">(</span><span class="hl str">''</span><span class="hl opt">,</span> <span class="hl num">0</span><span class="hl opt">);</span>
<span class="hl kwb">$checklist</span><span class="hl opt">-></span><span class="hl kwd">FormSetHeight</span><span class="hl opt">(</span><span class="hl kwb">$height</span><span class="hl opt">);</span>
<span class="hl kwb">$checklist</span><span class="hl opt">-></span><span class="hl kwd">FormSetBackground</span><span class="hl opt">(</span><span class="hl num">9</span><span class="hl opt">);</span>
<span class="hl kwc">my</span> <span class="hl kwb">@l</span> <span class="hl opt">=</span> map_index <span class="hl opt">{</span>
Newt<span class="hl opt">::</span>Component<span class="hl opt">::</span>Checkbox<span class="hl opt">(</span><span class="hl num">1</span><span class="hl opt">, $::</span>i <span class="hl opt">+</span> <span class="hl num">1</span><span class="hl opt">,</span> <span class="hl kwb">$_,</span> checkval<span class="hl opt">(${</span><span class="hl kwb">$val</span><span class="hl opt">->[$::</span>i<span class="hl opt">]} ||=</span> <span class="hl str">''</span><span class="hl opt">),</span> <span class="hl str">" *"</span><span class="hl opt">);</span>
<span class="hl opt">}</span> <span class="hl kwb">@$list</span><span class="hl opt">;</span>
<span class="hl kwb">$checklist</span><span class="hl opt">-></span><span class="hl kwd">FormAddComponent</span><span class="hl opt">(</span><span class="hl kwb">$_</span><span class="hl opt">)</span> <span class="hl kwa">foreach</span> <span class="hl kwb">@l</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl kwb">$listg</span> <span class="hl opt">=</span> Newt<span class="hl opt">::</span>Grid<span class="hl opt">::</span>HCloseStacked<span class="hl opt">(</span><span class="hl kwb">$checklist, $height</span> <span class="hl opt"><</span> <span class="hl kwb">@$list</span> ? <span class="hl opt">(</span>separator<span class="hl opt">(</span><span class="hl num">1</span><span class="hl opt">,</span> <span class="hl kwb">$height</span><span class="hl opt">),</span> <span class="hl kwb">$sb</span><span class="hl opt">) : ());</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$buttons, $ok, $cancel</span><span class="hl opt">) =</span> Newt<span class="hl opt">::</span>Grid<span class="hl opt">::</span>ButtonBar<span class="hl opt">(</span>_<span class="hl opt">(</span><span class="hl str">"Ok"</span><span class="hl opt">),</span> _<span class="hl opt">(</span><span class="hl str">"Cancel"</span><span class="hl opt">));</span>
<span class="hl kwc">my</span> <span class="hl kwb">$form</span> <span class="hl opt">=</span> Newt<span class="hl opt">::</span>Component<span class="hl opt">::</span>Form<span class="hl opt">(</span>\<span class="hl kwc">undef</span><span class="hl opt">,</span> <span class="hl str">''</span><span class="hl opt">,</span> <span class="hl num">0</span><span class="hl opt">);</span>
<span class="hl kwc">my</span> <span class="hl kwb">$window</span> <span class="hl opt">=</span> Newt<span class="hl opt">::</span>Grid<span class="hl opt">::</span>GridBasicWindow<span class="hl opt">(</span>first<span class="hl opt">(</span>myTextbox<span class="hl opt">(</span><span class="hl kwb">@$messages</span><span class="hl opt">)),</span> <span class="hl kwb">$listg, $buttons</span><span class="hl opt">);</span>
<span class="hl kwb">$window</span><span class="hl opt">-></span><span class="hl kwd">GridWrappedWindow</span><span class="hl opt">(</span><span class="hl kwb">$title</span><span class="hl opt">);</span>
<span class="hl kwb">$window</span><span class="hl opt">-></span><span class="hl kwd">GridAddComponentsToForm</span><span class="hl opt">(</span><span class="hl kwb">$form,</span> <span class="hl num">1</span><span class="hl opt">);</span>
<span class="hl kwc">my</span> <span class="hl kwb">$r</span> <span class="hl opt">=</span> <span class="hl kwb">$form</span><span class="hl opt">-></span><span class="hl kwd">RunForm</span><span class="hl opt">;</span>
<span class="hl kwb">$form</span><span class="hl opt">-></span><span class="hl kwd">FormDestroy</span><span class="hl opt">;</span>
Newt<span class="hl opt">::</span>PopWindow<span class="hl opt">;</span>
<span class="hl kwb">$$r</span> <span class="hl opt">==</span> <span class="hl kwb">$$cancel</span> <span class="hl kwc">and</span> <span class="hl kwa">return</span><span class="hl opt">;</span>
mapn <span class="hl opt">{</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$a, $b</span><span class="hl opt">) =</span> <span class="hl kwb">@_</span><span class="hl opt">;</span>
<span class="hl kwb">$$a</span> <span class="hl opt">=</span> <span class="hl kwb">$b</span><span class="hl opt">-></span><span class="hl kwd">CheckboxGetValue</span> <span class="hl opt">==</span> <span class="hl kwc">ord</span> <span class="hl str">'*'</span><span class="hl opt">;</span>
<span class="hl opt">}</span> <span class="hl kwb">$val,</span> \<span class="hl kwb">@l</span><span class="hl opt">;</span>
<span class="hl num">1</span><span class="hl opt">;</span>
<span class="hl opt">}</span>
<span class="hl kwa">sub</span> ask_from_entries_refW <span class="hl opt">{</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$o, $title, $messages, $l, $val, %hcallback</span><span class="hl opt">) =</span> <span class="hl kwb">@_</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$title_, @okcancel</span><span class="hl opt">) =</span> deref<span class="hl opt">(</span><span class="hl kwb">$title</span><span class="hl opt">);</span>
<span class="hl kwc">my</span> <span class="hl kwb">$ignore</span><span class="hl opt">;</span> <span class="hl slc">#-to handle recursivity</span>
<span class="hl kwc">my</span> <span class="hl kwb">$old_focus</span> <span class="hl opt">= -</span><span class="hl num">2</span><span class="hl opt">;</span>
<span class="hl slc">#-the widgets</span>
<span class="hl kwc">my</span> <span class="hl kwb">@widgets</span> <span class="hl opt">=</span> <span class="hl kwc">map</span> <span class="hl opt">{</span>
<span class="hl slc">#- $_->{type} = "entry" if $_->{type} eq "list" && !$_->{not_edit};</span>
<span class="hl opt">${</span><span class="hl kwb">$_</span><span class="hl opt">->{</span>val<span class="hl opt">}} ||=</span> <span class="hl str">''</span><span class="hl opt">;</span>
<span class="hl kwa">if</span> <span class="hl opt">(</span><span class="hl kwb">$_</span><span class="hl opt">->{</span>type<span class="hl opt">}</span> <span class="hl kwc">eq</span> <span class="hl str">"list"</span><span class="hl opt">) {</span>
<span class="hl kwc">my</span> <span class="hl kwb">$w</span> <span class="hl opt">=</span> Newt<span class="hl opt">::</span>Component<span class="hl opt">::</span>Listbox<span class="hl opt">(-</span><span class="hl num">1</span><span class="hl opt">, -</span><span class="hl num">1</span><span class="hl opt">,</span> <span class="hl num">1</span><span class="hl opt">,</span> <span class="hl num">0</span><span class="hl opt">);</span>
<span class="hl kwb">$w</span><span class="hl opt">-></span><span class="hl kwd">ListboxSetWidth</span><span class="hl opt">(</span><span class="hl num">20</span><span class="hl opt">);</span>
<span class="hl kwb">$w</span><span class="hl opt">-></span><span class="hl kwd">ListboxAddEntry</span><span class="hl opt">(</span><span class="hl kwb">$_</span><span class="hl opt">)</span> <span class="hl kwa">foreach</span> <span class="hl opt">@{</span><span class="hl kwb">$_</span><span class="hl opt">->{</span>list<span class="hl opt">}};</span>
<span class="hl kwb">$w</span><span class="hl opt">;</span>
<span class="hl opt">}</span> <span class="hl kwa">elsif</span> <span class="hl opt">(</span><span class="hl kwb">$_</span><span class="hl opt">->{</span>type<span class="hl opt">}</span> <span class="hl kwc">eq</span> <span class="hl str">"bool"</span><span class="hl opt">) {</span>
Newt<span class="hl opt">::</span>Component<span class="hl opt">::</span>Checkbox<span class="hl opt">(-</span><span class="hl num">1</span><span class="hl opt">, -</span><span class="hl num">1</span><span class="hl opt">,</span> <span class="hl kwb">$_</span><span class="hl opt">->{</span>text<span class="hl opt">} ||</span> <span class="hl str">''</span><span class="hl opt">,</span> checkval<span class="hl opt">(${</span><span class="hl kwb">$_</span><span class="hl opt">->{</span>val<span class="hl opt">}}),</span> <span class="hl str">" *"</span><span class="hl opt">);</span>
<span class="hl opt">}</span> <span class="hl kwa">else</span> <span class="hl opt">{</span>
Newt<span class="hl opt">::</span>Component<span class="hl opt">::</span>Entry<span class="hl opt">(-</span><span class="hl num">1</span><span class="hl opt">, -</span><span class="hl num">1</span><span class="hl opt">,</span> <span class="hl str">''</span><span class="hl opt">,</span> <span class="hl num">20</span><span class="hl opt">, (</span><span class="hl kwb">$_</span><span class="hl opt">->{</span>hidden<span class="hl opt">} &&</span> <span class="hl num">1</span> <span class="hl opt"><<</span> <span class="hl num">1</span><span class="hl opt">) |</span> <span class="hl num">1</span> <span class="hl opt"><<</span> <span class="hl num">2</span><span class="hl opt">);</span>
<span class="hl opt">}</span>
<span class="hl opt">}</span> <span class="hl kwb">@$val</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl kwb">@updates</span> <span class="hl opt">=</span> mapn <span class="hl opt">{</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$w, $ref</span><span class="hl opt">) =</span> <span class="hl kwb">@_</span><span class="hl opt">;</span>
<span class="hl kwa">sub</span> <span class="hl opt">{</span>
<span class="hl opt">${</span><span class="hl kwb">$ref</span><span class="hl opt">->{</span>val<span class="hl opt">}} =</span>
<span class="hl kwb">$ref</span><span class="hl opt">->{</span>type<span class="hl opt">}</span> <span class="hl kwc">eq</span> <span class="hl str">"bool"</span> ?
<span class="hl kwb">$w</span><span class="hl opt">-></span><span class="hl kwd">CheckboxGetValue</span> <span class="hl opt">==</span> <span class="hl kwc">ord</span> <span class="hl str">'*'</span> <span class="hl opt">:</span>
<span class="hl kwb">$ref</span><span class="hl opt">->{</span>type<span class="hl opt">}</span> <span class="hl kwc">eq</span> <span class="hl str">"list"</span> ?
<span class="hl kwb">$w</span><span class="hl opt">-></span><span class="hl kwd">ListboxGetCurrent</span> <span class="hl opt">:</span>
<span class="hl kwb">$w</span><span class="hl opt">-></span><span class="hl kwd">EntryGetValue</span><span class="hl opt">;</span>
<span class="hl opt">};</span>
<span class="hl opt">}</span> \<span class="hl kwb">@widgets, $val</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl kwb">@updates_inv</span> <span class="hl opt">=</span> mapn <span class="hl opt">{</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$w, $ref</span><span class="hl opt">) =</span> <span class="hl kwb">@_</span><span class="hl opt">;</span>
<span class="hl kwa">sub</span> <span class="hl opt">{</span>
<span class="hl kwc">my</span> <span class="hl kwb">$val</span> <span class="hl opt">= ${</span><span class="hl kwb">$ref</span><span class="hl opt">->{</span>val<span class="hl opt">}};</span>
<span class="hl kwb">$ignore</span> <span class="hl opt">=</span> <span class="hl num">1</span><span class="hl opt">;</span>
<span class="hl kwa">if</span> <span class="hl opt">(</span><span class="hl kwb">$ref</span><span class="hl opt">->{</span>type<span class="hl opt">}</span> <span class="hl kwc">eq</span> <span class="hl str">"bool"</span><span class="hl opt">) {</span>
<span class="hl kwb">$w</span><span class="hl opt">-></span><span class="hl kwd">CheckboxSetValue</span><span class="hl opt">(</span>checkval<span class="hl opt">(</span><span class="hl kwb">$val</span><span class="hl opt">));</span>
<span class="hl opt">}</span> <span class="hl kwa">elsif</span> <span class="hl opt">(</span><span class="hl kwb">$ref</span><span class="hl opt">->{</span>type<span class="hl opt">}</span> <span class="hl kwc">eq</span> <span class="hl str">"list"</span><span class="hl opt">) {</span>
map_index <span class="hl opt">{</span>
<span class="hl kwb">$w</span><span class="hl opt">-></span><span class="hl kwd">ListboxSetCurrent</span><span class="hl opt">($::</span>i<span class="hl opt">)</span> <span class="hl kwa">if</span> <span class="hl kwb">$val</span> <span class="hl kwc">eq</span> <span class="hl kwb">$_</span><span class="hl opt">;</span>
<span class="hl opt">} @{</span><span class="hl kwb">$ref</span><span class="hl opt">->{</span>list<span class="hl opt">}};</span>
<span class="hl opt">}</span> <span class="hl kwa">else</span> <span class="hl opt">{</span>
<span class="hl kwb">$w</span><span class="hl opt">-></span><span class="hl kwd">EntrySet</span><span class="hl opt">(</span><span class="hl kwb">$val,</span> <span class="hl num">1</span><span class="hl opt">);</span>
<span class="hl opt">}</span>
<span class="hl kwb">$ignore</span> <span class="hl opt">=</span> <span class="hl num">0</span><span class="hl opt">;</span>
<span class="hl opt">};</span>
<span class="hl opt">}</span> \<span class="hl kwb">@widgets, $val</span><span class="hl opt">;</span>
<span class="hl opt">&</span><span class="hl kwb">$_</span> <span class="hl kwa">foreach</span> <span class="hl kwb">@updates_inv</span><span class="hl opt">;</span>
<span class="hl slc">#- !! callbacks must be kept in a list otherwise perl will free them !!</span>
<span class="hl slc">#- (better handling of addCallback needed)</span>
<span class="hl kwc">my</span> <span class="hl kwb">@callbacks</span> <span class="hl opt">=</span> map_index <span class="hl opt">{</span>
<span class="hl kwc">my</span> <span class="hl kwb">$ind</span> <span class="hl opt">= $::</span>i<span class="hl opt">;</span>
<span class="hl kwa">sub</span> <span class="hl opt">{</span>
<span class="hl kwa">return if</span> <span class="hl kwb">$ignore</span><span class="hl opt">;</span> <span class="hl slc">#-handle recursive deadlock</span>
<span class="hl kwa">return</span> <span class="hl kwb">$old_focus++</span> <span class="hl kwa">if</span> <span class="hl kwb">$old_focus</span> <span class="hl opt">== -</span><span class="hl num">2</span><span class="hl opt">;</span> <span class="hl slc">#- handle special first case</span>
<span class="hl opt">&</span><span class="hl kwb">$_</span> <span class="hl kwa">foreach</span> <span class="hl kwb">@updates</span><span class="hl opt">;</span>
<span class="hl slc">#- TODO: this is very rough :(</span>
<span class="hl kwa">if</span> <span class="hl opt">(</span><span class="hl kwb">$old_focus</span> <span class="hl opt">==</span> <span class="hl kwb">$ind</span><span class="hl opt">) {</span>
<span class="hl kwb">$hcallback</span><span class="hl opt">{</span>changed<span class="hl opt">}->(</span><span class="hl kwb">$ind</span><span class="hl opt">)</span> <span class="hl kwa">if</span> <span class="hl kwb">$hcallback</span><span class="hl opt">{</span>changed<span class="hl opt">};</span>
<span class="hl opt">}</span> <span class="hl kwa">else</span> <span class="hl opt">{</span>
<span class="hl kwb">$hcallback</span><span class="hl opt">{</span>focus_out<span class="hl opt">}->(</span><span class="hl kwb">$ind</span><span class="hl opt">)</span> <span class="hl kwa">if</span> <span class="hl kwb">$hcallback</span><span class="hl opt">{</span>focus_out<span class="hl opt">};</span>
<span class="hl opt">}</span>
<span class="hl opt">&</span><span class="hl kwb">$_</span> <span class="hl kwa">foreach</span> <span class="hl kwb">@updates_inv</span><span class="hl opt">;</span>
<span class="hl kwb">$old_focus</span> <span class="hl opt">=</span> <span class="hl kwb">$ind</span><span class="hl opt">;</span>
<span class="hl opt">};</span>
<span class="hl opt">}</span> <span class="hl kwb">@widgets</span><span class="hl opt">;</span>
map_index <span class="hl opt">{</span> <span class="hl kwb">$_</span><span class="hl opt">-></span><span class="hl kwd">addCallback</span><span class="hl opt">(</span><span class="hl kwb">$callbacks</span><span class="hl opt">[$::</span>i<span class="hl opt">]) }</span> <span class="hl kwb">@widgets</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl kwb">$grid</span> <span class="hl opt">=</span> Newt<span class="hl opt">::</span>Grid<span class="hl opt">::</span>CreateGrid<span class="hl opt">(</span><span class="hl num">3</span><span class="hl opt">,</span> <span class="hl kwc">int</span> <span class="hl kwb">@$l</span><span class="hl opt">);</span>
map_index <span class="hl opt">{</span>
<span class="hl kwb">$grid</span><span class="hl opt">-></span><span class="hl kwd">GridSetField</span><span class="hl opt">(</span><span class="hl num">0</span><span class="hl opt">, $::</span>i<span class="hl opt">,</span> <span class="hl num">1</span><span class="hl opt">, ${</span>Newt<span class="hl opt">::</span>Component<span class="hl opt">::</span>Label<span class="hl opt">(-</span><span class="hl num">1</span><span class="hl opt">, -</span><span class="hl num">1</span><span class="hl opt">,</span> <span class="hl kwb">$_</span><span class="hl opt">)},</span> <span class="hl num">0</span><span class="hl opt">,</span> <span class="hl num">0</span><span class="hl opt">,</span> <span class="hl num">1</span><span class="hl opt">,</span> <span class="hl num">0</span><span class="hl opt">,</span> <span class="hl num">1</span><span class="hl opt">,</span> <span class="hl num">0</span><span class="hl opt">);</span>
<span class="hl kwb">$grid</span><span class="hl opt">-></span><span class="hl kwd">GridSetField</span><span class="hl opt">(</span><span class="hl num">1</span><span class="hl opt">, $::</span>i<span class="hl opt">,</span> <span class="hl num">1</span><span class="hl opt">, ${</span><span class="hl kwb">$widgets</span><span class="hl opt">[$::</span>i<span class="hl opt">]},</span> <span class="hl num">0</span><span class="hl opt">,</span> <span class="hl num">0</span><span class="hl opt">,</span> <span class="hl num">0</span><span class="hl opt">,</span> <span class="hl num">0</span><span class="hl opt">,</span> <span class="hl num">1</span><span class="hl opt">,</span> <span class="hl num">0</span><span class="hl opt">);</span>
<span class="hl opt">}</span> <span class="hl kwb">@$l</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$buttons, $ok, $cancel</span><span class="hl opt">) =</span> Newt<span class="hl opt">::</span>Grid<span class="hl opt">::</span>ButtonBar<span class="hl opt">(</span><span class="hl kwb">@okcancel</span><span class="hl opt">);</span>
<span class="hl kwc">my</span> <span class="hl kwb">$form</span> <span class="hl opt">=</span> Newt<span class="hl opt">::</span>Component<span class="hl opt">::</span>Form<span class="hl opt">(</span>\<span class="hl kwc">undef</span><span class="hl opt">,</span> <span class="hl str">''</span><span class="hl opt">,</span> <span class="hl num">0</span><span class="hl opt">)</span> <span class="hl kwc">or die</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl kwb">$window</span> <span class="hl opt">=</span> Newt<span class="hl opt">::</span>Grid<span class="hl opt">::</span>GridBasicWindow<span class="hl opt">(</span>first<span class="hl opt">(</span>myTextbox<span class="hl opt">(</span><span class="hl kwb">@$messages</span><span class="hl opt">)),</span> <span class="hl kwb">$grid, $buttons</span><span class="hl opt">);</span>
<span class="hl kwb">$window</span><span class="hl opt">-></span><span class="hl kwd">GridWrappedWindow</span><span class="hl opt">(</span><span class="hl kwb">$title_</span><span class="hl opt">);</span>
<span class="hl kwb">$window</span><span class="hl opt">-></span><span class="hl kwd">GridAddComponentsToForm</span><span class="hl opt">(</span><span class="hl kwb">$form,</span> <span class="hl num">1</span><span class="hl opt">);</span>
run<span class="hl opt">:</span>
<span class="hl kwc">my</span> <span class="hl kwb">$r</span> <span class="hl opt">=</span> <span class="hl kwb">$form</span><span class="hl opt">-></span><span class="hl kwd">RunForm</span><span class="hl opt">;</span>
<span class="hl opt">&</span><span class="hl kwb">$_</span> <span class="hl kwa">foreach</span> <span class="hl kwb">@updates</span><span class="hl opt">;</span>
<span class="hl kwa">if</span> <span class="hl opt">(</span><span class="hl kwb">$$r</span> <span class="hl opt">!=</span> <span class="hl kwb">$$cancel</span> <span class="hl opt">&&</span> <span class="hl kwb">$hcallback</span><span class="hl opt">{</span>complete<span class="hl opt">}) {</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$error, $focus</span><span class="hl opt">) =</span> <span class="hl kwb">$hcallback</span><span class="hl opt">{</span>complete<span class="hl opt">}->();</span>
<span class="hl slc">#-update all the value</span>
<span class="hl opt">&</span><span class="hl kwb">$_</span> <span class="hl kwa">foreach</span> <span class="hl kwb">@updates_inv</span><span class="hl opt">;</span>
<span class="hl kwa">goto</span> run <span class="hl kwa">if</span> <span class="hl kwb">$error</span><span class="hl opt">;</span>
<span class="hl opt">}</span>
<span class="hl kwb">$form</span><span class="hl opt">-></span><span class="hl kwd">FormDestroy</span><span class="hl opt">;</span>
Newt<span class="hl opt">::</span>PopWindow<span class="hl opt">;</span>
<span class="hl kwb">$$r</span> <span class="hl opt">!=</span> <span class="hl kwb">$$cancel</span><span class="hl opt">;</span>
<span class="hl opt">}</span>
<span class="hl kwa">sub</span> waitbox<span class="hl opt">(</span><span class="hl kwb">$$</span><span class="hl opt">) {</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$title, $messages</span><span class="hl opt">) =</span> <span class="hl kwb">@_</span><span class="hl opt">;</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$t, $w, $h</span><span class="hl opt">) =</span> myTextbox<span class="hl opt">(</span><span class="hl kwb">@$messages</span><span class="hl opt">);</span>
<span class="hl kwc">my</span> <span class="hl kwb">$f</span> <span class="hl opt">=</span> Newt<span class="hl opt">::</span>Component<span class="hl opt">::</span>Form<span class="hl opt">(</span>\<span class="hl kwc">undef</span><span class="hl opt">,</span> <span class="hl str">''</span><span class="hl opt">,</span> <span class="hl num">0</span><span class="hl opt">);</span>
Newt<span class="hl opt">::</span>CenteredWindow<span class="hl opt">(</span><span class="hl kwb">$w, $h, $title</span><span class="hl opt">);</span>
<span class="hl kwb">$f</span><span class="hl opt">-></span><span class="hl kwd">FormAddComponent</span><span class="hl opt">(</span><span class="hl kwb">$t</span><span class="hl opt">);</span>
<span class="hl kwb">$f</span><span class="hl opt">-></span><span class="hl kwd">DrawForm</span><span class="hl opt">;</span>
Newt<span class="hl opt">::</span>Refresh<span class="hl opt">;</span>
<span class="hl kwb">$f</span><span class="hl opt">-></span><span class="hl kwd">FormDestroy</span><span class="hl opt">;</span>
<span class="hl kwc">push</span> <span class="hl kwb">@wait_messages, $f</span><span class="hl opt">;</span>
<span class="hl kwb">$f</span><span class="hl opt">;</span>
<span class="hl opt">}</span>
<span class="hl kwa">sub</span> wait_messageW<span class="hl opt">(</span><span class="hl kwb">$$$</span><span class="hl opt">) {</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$o, $title, $messages</span><span class="hl opt">) =</span> <span class="hl kwb">@_</span><span class="hl opt">;</span>
<span class="hl opt">{</span> form <span class="hl opt">=></span> waitbox<span class="hl opt">(</span><span class="hl kwb">$title, $messages</span><span class="hl opt">),</span> title <span class="hl opt">=></span> <span class="hl kwb">$title</span> <span class="hl opt">};</span>
<span class="hl opt">}</span>
<span class="hl kwa">sub</span> wait_message_nextW <span class="hl opt">{</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$o, $messages, $w</span><span class="hl opt">) =</span> <span class="hl kwb">@_</span><span class="hl opt">;</span>
<span class="hl kwb">$o</span><span class="hl opt">-></span><span class="hl kwd">wait_message_endW</span><span class="hl opt">(</span><span class="hl kwb">$w</span><span class="hl opt">);</span>
<span class="hl kwb">$o</span><span class="hl opt">-></span><span class="hl kwd">wait_messageW</span><span class="hl opt">(</span><span class="hl kwb">$w</span><span class="hl opt">->{</span>title<span class="hl opt">},</span> <span class="hl kwb">$messages</span><span class="hl opt">);</span>
<span class="hl opt">}</span>
<span class="hl kwa">sub</span> wait_message_endW <span class="hl opt">{</span>
<span class="hl kwc">my</span> <span class="hl opt">(</span><span class="hl kwb">$o, $w</span><span class="hl opt">) =</span> <span class="hl kwb">@_</span><span class="hl opt">;</span>
<span class="hl kwc">log</span><span class="hl opt">::</span>l<span class="hl opt">(</span><span class="hl str">"interactive_newt does not handle none stacked wait-messages"</span><span class="hl opt">)</span> <span class="hl kwa">if</span> <span class="hl kwb">$w</span><span class="hl opt">->{</span>form<span class="hl opt">} !=</span> <span class="hl kwc">pop</span> <span class="hl kwb">@wait_messages</span><span class="hl opt">;</span>
Newt<span class="hl opt">::</span>PopWindow<span class="hl opt">;</span>
<span class="hl opt">}</span>
<span class="hl kwa">sub</span> <span class="hl kwc">kill</span> <span class="hl opt">{</span>
<span class="hl opt">}</span>
<span class="hl num">1</span><span class="hl opt">;</span>
</code></pre></td></tr></table>
</div> <!-- class=content -->
<div class='footer'>generated by <a href='https://git.zx2c4.com/cgit/about/'>cgit v1.2.1</a> (<a href='https://git-scm.com/'>git 2.21.0</a>) at 2025-03-09 19:40:08 +0000</div>
</div> <!-- id=cgit -->
</body>
</html>