如何在 Perl/Tk 笔记本小部件中嵌入 X 窗口？

Question

我找到了如何在 Perl/Tk Notebook 小部件中嵌入任意 X 应用程序窗口的示例。 但是，我无法使其发挥作用。具体来说，对

X->ReparentWindow

的调用不起作用。 调用时，

xterm

应用程序应该已从显示在由窗口管理器管理的单独窗口中移动到显示在 perl/Tk 应用程序中的笔记本选项卡内。

我已将相关代码提取到下面的示例中，该示例假设名为

xterm

的窗口已在运行。 运行时，

xterm

窗口不会嵌入笔记本选项卡内。 它仍然是一个单独的窗口。 我已经确认

get_window_by_name

函数通过其“类”找到指定的窗口。

#!/usr/bin/env perl
use Tk;
use X11::Protocol;
use Tk::NoteBook;
use Data::Dumper;
my $X        = X11::Protocol->new();
my $mw       = MainWindow->new();
my $topframe = $mw->Frame()->pack(-side => 'top');
my $notebook = $topframe->NoteBook()->pack;
my $tab      = $notebook->add("example", -label => "Example");
my $pid;

unless ($pid = fork) { exec("xterm"); }

if ($pid) { sleep(3); grab_it("xterm", $tab); MainLoop(); }

sub grab_it
{
   my $winname = shift;
   my $tab     = shift;
   my $x_window_id;

   $x_window_id = get_window_by_name($winname);
   if (!$x_window_id) { exit(1) }

   $tab->update;
   $X->ReparentWindow($x_window_id, oct($tab->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) = grep { $X->GetAtomName($_) eq "WM_CLASS" } $X->ListProperties($k);
      if (defined $atomnr)
      {
         my ($class, $name) = split(/\0/, ($X->GetProperty($k, $atomnr, "AnyPropertyType", 0, 256, 0))[0]);
         if ($class =~ $searchname)
         {
            return $k;
         }
      }
      my $ret = _get_window_by_name($k, $searchname);
      if (defined $ret)
      {
         return $ret;
      }
   }
   undef;
}

Answer 1

我无法让 X11::Protocol 的父窗口正常工作。相反，尝试使用

-into

选项将窗口 id 直接提供给 xterm。另外，在笔记本中创建一个允许嵌入的容器框架：

#!/usr/bin/env perl
use strict;
use warnings;
use Tk;

my $mw = MainWindow->new();
$mw->title("XTerm Embedded in Tk");

my $notebook = $mw->NoteBook()->pack(-expand => 1, -fill => 'both');
my $tab = $notebook->add("example", -label => "Example");

# Create a frame within the tab to serve as a container
my $embed_frame = $tab->Frame(
    -container => 1,          # Set the frame as a container
    -width     => 600,
    -height    => 400,
)->pack(-expand => 1, -fill => 'both');

# Ensure the frame is realized and has a window ID
$embed_frame->update();

my $window_id = $embed_frame->id;
my $pid = fork();
if (not defined $pid) {
    die "Cannot fork: $!";
} elsif ($pid == 0) {
    # Child process
    exec("xterm", "-into", $window_id, "-geometry", "80x24") or die "Cannot exec xterm: $!";
    exit(0);
}

# Start the Tk event loop
MainLoop();