Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Swallowing X11 apps in Tk

by strredwolf (Chaplain)
on May 25, 2001 at 21:51 UTC ( [id://83360]=perlquestion: print w/replies, xml ) Need Help??

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

Has anyone tried to "swallow" an arbitrary X11 app in a Perl/Tk script? I'm thinking about doing a dock manager in there, and know about Tk::Frame(-container), but as some know, Tk (as well as Tcl/Tk)'s own docs leave something to be desired.

--
$Stalag99{"URL"}="http://stalag99.keenspace.com";

Replies are listed 'Best First'.
Re: Swallowing X11 apps in Tk
by danger (Priest) on May 25, 2001 at 23:39 UTC

    Some time ago, Slaven Rezic posted a little program (to clp.tk) to steal and reparent an X11 window. I only toyed with it briefly, but did clean up some warnings it emitted (I can't seem to find the original). This version will spawn 5 xterm's (or pass it a number) and reparent them on pages of a NoteBook widget --- wait for it though, it is slow and clunky (but maybe it'll give you some ideas):

    #!/usr/bin/perl -w use strict; # this script is a modified version of: ## $Id: ptk_steal.pl,v 1.1 1999/07/01 19:56:31 eserte Exp $ ## Author: Slaven Rezic ## ## Copyright (C) 1999 Slaven Rezic. All rights reserved. ## This program is free software; you can redistribute it and/or ## modify it under the same terms as Perl itself. use Tk; use X11::Protocol; use Tk::NoteBook; my $shells = $ARGV[0] || 5; my @Pids; my %Pages; my $X = X11::Protocol->new(); my $mw = MainWindow->new(); my $topframe = $mw->Frame()->pack(-side => 'top'); $topframe->Button(-text => 'Exit', -command => sub{kill(9,@Pids); $mw->destroy})->pack(-side => 'right +'); my $botframe = $mw->Frame(-borderwidth => 2, -relief => 'groove', )->pack(-side => 'bottom',-expand => 1); my $nbook = $botframe->NoteBook()->pack; for(1 ..$shells){ $Pages{$_} = $nbook->add("page$_", -label => "Shell$_", -underline => 5); my $pid; unless ($pid = fork){ exec("color_xterm -ls -sb -bg 'gray64' -name WindowToSteal$_") +; } if ($pid){ grab_it("WindowToSteal$_", $Pages{$_}); push @Pids,$pid; } } MainLoop(); sub grab_it { my $winname = shift; my $pane = shift; my $wid; my $check = $pane->repeat(50, sub { $wid = get_window_by_name($winname); }); while (!defined $wid) { $pane->waitVariable(\$wid); } $check->cancel; my $f = $pane->Frame('-container' => 1)->pack(-side => 'bottom'); $f->update; $X->ReparentWindow($wid, oct($f->id), 0, 0); } sub get_window_by_name { _get_window_by_name($X->{'root'}, $_[0]); } sub _get_window_by_name { my($root, $searchname) = @_; my(undef, undef, @new_kids) = $X->QueryTree($root); foreach my $k (@new_kids) { my $atomnr; foreach my $atom ($X->ListProperties($k)) { if ($X->GetAtomName($atom) eq "WM_CLASS") { $atomnr = $atom; last; } } if (defined $atomnr) { my($classprop) = $X->GetProperty($k, $atomnr, "AnyPropertyType +",0, 256, 0); my($class, $name) = split(/\0/, $classprop); if ($class eq $searchname) { return $k; } } my $ret = _get_window_by_name($k, $searchname); if (defined $ret) { return $ret; } } undef; } __END__

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://83360]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others perusing the Monastery: (7)
As of 2024-03-28 19:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found