aplonis has asked for the wisdom of the Perl Monks concerning the following question:

I cobbled a little PerlTk script to run on NetBSD with three simple goals:

1. Launch `xmodmap ~/.Xmodmap_esperanto`
2. Launch `xmodmap /usr/X11R6/lib/X11/etc/xmodmap.std`
3. Launch `xterm +u8 -fn
-misc-fixed-medium-r-normal--14-130-75-75-c-70-iso10646-1`

It is just so I can swap between Esperanto and English keyboards in XFree86 and also open xterm as Unicode with font of choice.

Goals 1 & 2 are easy, since xmodmap does its thing and ends. But goal 3 is a problem since it stays alive.

With backticks or system(), PerlTk stops dead in its tracks until xterm is closed. I want the xterm to break away free. I wouldn't mind if goal three were a ~/foo.sh script or some such, but I'd like a Tk button to launch it.

Whatever works is fine by me. Thanks.

Gan Starling, Kalamazoo MI, USA

Replies are listed 'Best First'.
Re: Launch from Tk
by converter (Priest) on May 30, 2003 at 05:51 UTC

    exec() replaces the current process with a new one. When you call exec from the perl process that's running your Tk program you replace it with the exec'd process. The solution is to fork() and run exec() from the child process.

    The only issue I'm not 100% certain about is the handling of the CHLD signal and child exit status, particularly when exec() fails. Hopefully someone with a better grasp of the issues can help clear that up.

    Here's a short example: 

    #!/usr/bin/perl
use Tk;

sub go {
    local $SIG{CHLD} = 'IGNORE';   # don't wait for child
                                   # exit status. avoids
                                   # zombies.
    die "fork failed: $!" unless defined($pid = fork);
    return if $pid;
    exec("xterm");
    warn "exec failed: $!";
    CORE::exit(1);
}

$m = tkinit; 

$m->Button(-text=>"Foo",-command=>sub{print"Foo\n"})->pack;
$m->Button(-text=>"Go",-command=>\&go)->pack;

MainLoop;

    [download]
[reply]
[d/l]
[select]
      That seems to work. Most helpful, thank you. Here is the updated PerlTk program (tested on NetBSD 1.6.1_STABLE) 
      #!/usr/pkg/bin/perl 
# gus_kbds.pl version 1.01
# Copyright (c) 2003 by Gan Uesli Starling

use Tk;
use strict;

use vars qw( 
  $programo_1 
  $xmodmap_verda $xmodmap_alia 
  $e_feedback $feedback 
  $pid_1
);

sub set_defaults {
 $xmodmap_verda = "/home/aplonis/.Xmodmap_verda";
 $xmodmap_alia = "/usr/X11R6/lib/X11/etc/xmodmap.std";
 $programo_1 = "xterm -u8 -fn -misc-fixed-medium-r-normal--14-130-75-75-c-70-iso10646-1 -name FOO";
}

set_defaults; # Do right away.

# Give initial feedback hint.
$feedback = "Premu butonon.";

# The main window.
my $mw_kbd = MainWindow->new(-title=>'Klavo-sxangxilo');

# Frame for buttons.
my $fm_kbds = $mw_kbd->Frame(-relief=>'flat',-borderwidth=>5);
my $bn_tajpu = $fm_kbds->Button( 
  -relief=>'raised',-text=>"Tajpu",-command=>\&tajpu,-width=>5,
  -background=>'gray',-activebackground=>'orange');
my $bn_eo = $fm_kbds->Button( 
  -relief=>'raised',-text=>"Verda",-command=>\&kbd_eo,-width=>5,
  -background=>'gray',-activebackground=>'green');
my $bn_en = $fm_kbds->Button(
  -relief=>'raised',-text=>"Alia",-command=>\&kbd_en,-width=>5,
  -background=>'gray',-activebackground=>'blue');
my $b_cls = $fm_kbds->Button(
  -relief=>'raised',-text=>"Finu",-command=>\&quit_MainLoop,
  -background=>"gray",-activebackground=>"red");
$bn_tajpu->pack(-side=>'left',-expand=>1,-fill=>'x');
$bn_en->pack(-side=>'left',-expand=>1,-fill=>'x');
$bn_eo->pack(-side=>'left',-expand=>1,-fill=>'x');
$b_cls->pack(-side=>'left');
$fm_kbds->pack(-side=>'top',-expand=>0,-fill=>'x');

################################
# BEGIN PROBLEM AREA -- SOLVED #
################################

sub tajpu {
    local $SIG{CHLD} = 'IGNORE';   # don't wait for child
                                   # exit status. avoids
                                   # zombies.
    die "fork failed: $!" unless defined($pid_1 = fork);
    return if $pid_1;
		$feedback = $programo_1;
    exec("$programo_1");
    warn "exec failed: $!";
    CORE::exit(1);
}

##############################
# END PROBLEM AREA -- SOLVED #
##############################

sub kbd_eo {
 $feedback = 'Klavaro verdas!';
 `xmodmap $xmodmap_verda`;
}

sub kbd_en {
 $feedback = 'Klavaro malverdas.';
 `xmodmap $xmodmap_alia`;
}

# Frame for info.
my $fm_btm = $mw_kbd->Frame(-relief=>'flat',-borderwidth=>5);
my $e_feedback = $fm_btm->Entry(
  -width=>20,	
  -textvariable=>\$feedback,-font =>'courier',
  -background=>"white",-foreground=>'blue');
$e_feedback->pack(-side=>'left',-expand=>1,-fill=>'x');
$fm_btm->pack(-side=>'bottom',-expand=>0,-fill=>'x');

# Backup results and quit program.
sub quit_MainLoop {
  $mw_kbd->destroy() if Tk::Exists($mw_kbd);
}

MainLoop;
      And, just for completeness, here is the xternal Esperanto file ~/.Xmodmap_verda which Perl feeds to xmodmap for XFree86. It was created with the /usr/pkgsrc/x11/xkeycaps package. 
      !
! This is an `xmodmap' input file for 
!   PC 101 key, thin Delete, tall Enter (XFree86; US) keyboards.
! Automatically generated on Thu May 29 01:33:57 2003 by aplonis with
! XKeyCaps 2.46; Copyright (c) 1999 Jamie Zawinski <jwz@jwz.org>.
! http://www.jwz.org/xkeycaps/
!
keycode 0x6F =	Print	Sys_Req
keycode 0x18 =	ccircumflex	Ccircumflex
keycode 0x19 =	ubreve	Ubreve
keycode 0x1D =	jcircumflex	Jcircumflex
keycode 0x22 =	gcircumflex	Gcircumflex
keycode 0x23 =	hcircumflex	Hcircumflex
keycode 0x35 =	scircumflex	Scircumflex
keycode 0x40 =	Alt_L	Meta_L
keycode 0x71 =	Alt_R	Meta_R
      I will write up a howto for this and post it first on the following URL:

      starling.us/gus_netbsd

      ...then sometime later, translate it for...

      esperanto.us
[reply]
Re: Launch from Tk
by aplonis (Pilgrim) on May 30, 2003 at 04:06 UTC
    Here is the whole script...

    #!/usr/pkg/bin/perl 
# gus_kbds.pl version 1.01
# Copyright (c) 2003 by Gan Uesli Starling

use Tk;
use strict;

use vars qw( 
  $programo_1 
	$xmodmap_verda $xmodmap_alia 
	$e_feedback $feedback 
  $pid_1
);

sub set_defaults {
 $xmodmap_verda = "~/.Xmodmap_verda";
 $xmodmap_alia = "/usr/X11R6/lib/X11/etc/xmodmap.std";
 $programo_1 = "~/.Xmodmap_programo_1";
}

set_defaults; # Do right away.

# Give initial feedback hint.
$feedback = "Premu butonon.";

# The main window.
my $mw_kbd = MainWindow->new(-title=>'Klavo-sxangxilo');

# Frame for buttons.
my $fm_kbds = $mw_kbd->Frame(-relief=>'flat',-borderwidth=>5);
my $bn_tajpu = $fm_kbds->Button( 
  -relief=>'raised',-text=>"Tajpu",-command=>\&tajpu,-width=>5,
  -background=>'gray',-activebackground=>'orange');
my $bn_eo = $fm_kbds->Button( 
  -relief=>'raised',-text=>"Verda",-command=>\&kbd_eo,-width=>5,
  -background=>'gray',-activebackground=>'green');
my $bn_en = $fm_kbds->Button(
  -relief=>'raised',-text=>"Alia",-command=>\&kbd_en,-width=>5,
  -background=>'gray',-activebackground=>'blue');
my $b_cls = $fm_kbds->Button(
  -relief=>'raised',-text=>"Finu",-command=>\&quit_MainLoop,
  -background=>"gray",-activebackground=>"red");
$bn_tajpu->pack(-side=>'left',-expand=>1,-fill=>'x');
$bn_en->pack(-side=>'left',-expand=>1,-fill=>'x');
$bn_eo->pack(-side=>'left',-expand=>1,-fill=>'x');
$b_cls->pack(-side=>'left');
$fm_kbds->pack(-side=>'top',-expand=>0,-fill=>'x');

######################
# BEGIN PROBLEM AREA #
######################

sub tajpu {
 $feedback = $programo_1;
 exec("~/.Xmodmap_programo_1");
}

####################
# END PROBLEM AREA #
####################

sub kbd_eo {
 $feedback = 'Klavaro verdas!';
 `xmodmap $xmodmap_verda`;
}

sub kbd_en {
 $feedback = 'Klavaro malverdas.';
 `xmodmap $xmodmap_alia`;
}

# Frame for info.
my $fm_btm = $mw_kbd->Frame(-relief=>'flat',-borderwidth=>5);
my $e_feedback = $fm_btm->Entry(
  -width=>20,	
  -textvariable=>\$feedback,-font =>'courier',
  -background=>"white",-foreground=>'blue');
$e_feedback->pack(-side=>'left',-expand=>1,-fill=>'x');
$fm_btm->pack(-side=>'bottom',-expand=>0,-fill=>'x');

# Backup results and quit program.
sub quit_MainLoop {
  $mw_kbd->destroy() if Tk::Exists($mw_kbd);
}

MainLoop;
[reply]
Re: Launch from Tk
by theorbtwo (Prior) on May 30, 2003 at 03:23 UTC

    use exec instead of backticks or system, and run the script in the background.

    Warning: Unless otherwise stated, code is untested. Do not use without understanding. Code is posted in the hopes it is useful, but without warranty. All copyrights are relinquished into the public domain unless otherwise stated. I am not an angel. I am capable of error, and err on a fairly regular basis. If I made a mistake, please let me know (such as by replying to this node).

[reply]
      If I do...
      exec("foo");
      ...then I get the xterm, but Tk dies.

      If I do...
      exec("foo","&");
      ...nothing happens when Tk's button is clicked.
[reply]
Re: Launch from Tk
by Anonymous Monk on May 30, 2003 at 03:05 UTC
    why not do something like ... xterm +u8 -fn &
[reply]

      Yes, thought of that first.

      If I do...
      `foo bar &`;
      ...Tk freezes till xterm is closed.

      If I do...
      system("foo", "bar", "&");
      ...then xterm rejects the & as bad cli option.

      If I put the xterm call in foo.sh and do...
      `~/foo.sh &`;
      ...Tk still freezes till xterm is closed.

      If I put the xterm call in foo.sh and do...
      system("~/foo.sh", "&");
      ...nothing apears to happen. I get no xterm.

      But if I call ~/foo.sh on the cli, thin I do
      get the xterm. So the script foo.sh is okay.

      I tried all those things before coming here.
      I am a little stumped.
[reply]
        What if you put 
        #!/bin/sh
xterm +u8 -fn ... &

        [download]
        in ~/foo.sh and then did system '~/foo.sh'?

        (I'd test it right now, but I'm at school.)

[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom