Hi Mikhael,
> > Should I expect to get an 'observation' if I dynamically change
> > config parameters? (using FvwmTalk or FvwmCommand) The dynamic values
> > are only propogated after I restart FvwmTabs.
>
> There were some problems that are fixed now.
Ah, CVS version works as expected - thanks.
> Please try new Colorsets tracker. Making the colorset fg/bg work is not
> interesting. It would be nice if you can make colorset pixmaps work using
> Perl/Tk or X11::Protocol. Maybe you can create a Tk window that shows all
> available colorsets using rectangle of 48x48 and some text in it (like
> colorset number in brackets). I am waiting for your experiments. :)
Well my "experiments" are complete. I couldn't work out a way to do it
with just Tk so I ended up using Tk & X11::Protocol. Be warned though:
this is nasty code - its only purpose was to provide me with an intellectual
challenge! (or did you have a greater purpose in mind?)
SCoTT. :)
#!/usr/bin/perl -w
use strict;
use lib `fvwm-perllib dir`;
use FVWM::Module;
use FVWM::Module::Toolkit 'X11::Protocol';
use FVWM::Module::Toolkit 'Tk'; # aka: use Tk;
use FVWM::Module::Toolkit 'Tk::LabFrame';
use FVWM::Module::Tk;
use constant FIELDS => qw(fg bg hilite shadow fgsh pixmap);
my $main = new MainWindow();
my $x = X11::Protocol->new($main->screen());
$x->event_handler('queue');
my $module = new FVWM::Module::Tk($main, Name => 'ShowColorsets', Debug => 2);
my $tracker = $module->track('Colorsets');
$module->debug("initialized\n" . $tracker->dump . ("-" x 74));
my %info;
my %cs;
foreach my $n (keys(%{$tracker->{data}}))
{
my $f = $main->Frame()->pack(-side => 'top');
$f->Label(-text => "Colorset $n:")->pack(-side => 'left');
my $pConfig = $tracker->data($n);
# foreach my $k (keys(%{$pConfig->{$n}}))
# {
# $module->debug("$k=" . $pConfig->{$n}->{$k} . "\n");
# }
$module->debug("Colorset $n: " . join(", ", map("$_ = $pConfig->{$_}",
keys(%{$pConfig}))));
foreach (FIELDS)
{
my $lf = $f->LabFrame(-label => $_,
-labelside =>
'acrosstop')->pack(-side => 'left');
my $f = $lf->Frame(-width => 48, -height => 48)->pack();
my $win = hex($f->id());
my $type = ($_ eq 'pixmap' ? 'background_pixmap' :
'background_pixel');
$info{$win}{type} = $type;
$info{$win}{val} = $pConfig->{$_};
$cs{$n}{$_} = $win;
# redraw($win);
}
}
$tracker->observe("main", sub {
my ($module, $tracker, $z, $nn, $p) = @_;
my $headline = "s2:" . $tracker->observables->[0];
$module->debug("$headline\n" . $tracker->dump($p) . ("-" x 74));
print("z=$z nn=$nn\n");
# foreach (keys(%{$z->{$nn}}))
# foreach (keys(%{$p}))
foreach (FIELDS)
{
my $win = $cs{$nn}{$_};
$info{$win}{val} = $p->{$_};
redraw($win);
# print("$_=\n");
# print("$_=$p->{$_}\n");
}
});
$main->Button(-text => 'Quit',
-command => sub{exit}
)->pack(-side => 'left');
$main->Button(-text => 'Show',
-command => \&redrawAll,
)->pack(-side => 'left');
sub redrawAll ()
{
foreach (keys(%info))
{
redraw($_);
}
}
sub redraw ($)
{
my ($win) = @_;
return if (!exists $info{$win});
my $t = $info{$win}{type};
my $v = $info{$win}{val};
# print("redraw($win) t=$t v=$v\n");
my $rv = $x->ChangeWindowAttributes($win,
$t => $v,
event_mask => $x->pack_event_mask('Exposure', 'StructureNotify'));
$x->req('ClearArea', $win, (0, 0), 200, 200, 0);
}
sub eventHandler
{
my (%event) = @_;
# print("Got a $event{name} event: " . join(", ", map("$_ =
$event{$_}", keys(%event))) . "\n");
if ($event{name} eq 'ConfigureNotify' ||
$event{name} eq 'Expose')
{
redraw($event{window});
}
}
sub callback
{
# $xServer->handle_input();
# $xServer->next_event();
# TODO: why do I have to send a req to get events.
# Need a non-blocking way to get an event.
$x->req('ListProperties', $x->root());
while (1)
{
my %event = $x->dequeue_event();
last if (!exists($event{name}));
eventHandler(%event);
}
}
$main->repeat(250, \&callback);
$main->after(1, sub { $main->waitVisibility(); redrawAll(); });
$module->eventLoop();
