# $Source: /home/keck/lib/perl/X11/RCS/Tops.pm,v $
# $Revision: 3.25 $$Date: 2007/07/07 07:52:11 $
# Contents
# 1 standard 13 X 25 command
# 2 constants 14 match 26 monitor changes
# 3 new 15 active 27 raise & lower
# 4 fetch_ids 16 stacking 28 geometry
# 5 update_ids 17 gravity 29 frame_geometry
# 6 update_from_props 18 monitor changes 30 wm_normal_hints
# 7 update 19 X11::Top 31 parse_geometry
# 8 byid 20 instance 32 requested geometry
# 9 choosechar 21 class 33 move
# 10 sort 22 title 34 expand
# 11 sorted 23 icon 35 notes
# 12 bychar 24 char 36 pod
# ----------------------------------------------------------------------
#1# standard
package X11::Tops;
use X11::Protocol;
use Carp;
use Data::Dumper;
use strict;
use warnings;
our $VERSION = 0.2;
# ----------------------------------------------------------------------
#2# constants
my @getpropconst = ('AnyPropertyType', 0, -1, 0);
# ----------------------------------------------------------------------
#3# new
sub new {
my $X = shift;
$X = X11::Protocol->new() unless ref $X;
my $xtops;
$xtops->{X} = $X;
$xtops->{root} = $X->root; # assumes only 1 screen
$xtops->{$_} = $X->InternAtom($_, 0) for qw(
_NET_CLIENT_LIST
_XCHAR_CHAR
_XCHAR_COMMAND
);
$xtops->{$_} = $X->atom($_) for qw(
_WIN_CLIENT_LIST
_NET_ACTIVE_WINDOW
_NET_CLIENT_LIST_STACKING
WM_CLASS
WM_NAME
WM_ICON_NAME
STRING
WM_NORMAL_HINTS
WM_SIZE_HINTS
);
$xtops->{$_} || croak("failed to create atom $_") for qw(
_XCHAR_CHAR
_XCHAR_COMMAND
);
bless $xtops;
}
# ----------------------------------------------------------------------
#4# fetch_ids
sub fetch_ids {
my $xtops = shift;
my $X = $xtops->{X};
my $root = $xtops->{root};
my $_NET_CLIENT_LIST = $xtops->{_NET_CLIENT_LIST};
my ($value, $type, $format, $bytes_after) =
$X->GetProperty($root, $_NET_CLIENT_LIST, @getpropconst);
my @ids = unpack('L*', $value);
\@ids;
}
# ----------------------------------------------------------------------
#5# update_ids
sub update_ids {
my $xtops = shift;
my $ids = $xtops->fetch_ids;
$xtops->{byid}{$_} =
bless { xtops => $xtops, id => $_ }, 'X11::Top'
for @$ids;
$xtops;
}
# ----------------------------------------------------------------------
#6# update_from_props
sub update_from_props {
my $xtops = shift;
$xtops->update_ids;
for my $xtop (values %{$xtops->{byid}}) {
$xtop->class;
$xtop->char;
}
$xtops;
}
# ----------------------------------------------------------------------
#7# update
sub update {
my $xtops = shift;
my @deleted = ();
my $newids = $xtops->fetch_ids;
if ($xtops->{byid}) {
my %seen;
for my $id (@$newids) {
$seen{$id} = 1;
$xtops->{byid}{$id} =
bless { xtops => $xtops, id => $id }, 'X11::Top'
unless $xtops->{byid}{$id};
}
for my $id (keys %{$xtops->{byid}}) {
push(@deleted, $xtops->{byid}{$id}) unless $seen{$id};
}
for my $xtop (@deleted) {
delete $xtops->{byid}{$xtop->{id}};
delete $xtops->{chars_in_use}{$xtop->{char}};
}
} else {
for my $id (@$newids) {
$xtops->{byid}{$id} =
bless { xtops => $xtops, id => $id }, 'X11::Top';
}
}
for my $xtop (values %{$xtops->{byid}}) {
$xtop->{instance} = $xtop->instance unless
defined $xtop->{instance};
$xtop->{char} = $xtops->choosechar($xtop) unless
defined $xtop->{char};
}
$xtops->sort;
@deleted;
}
# ----------------------------------------------------------------------
#8# byid
sub byid {
my $xtops = shift;
$xtops->{byid};
}
# ----------------------------------------------------------------------
#9# choosechar
# assume instances set
sub choosechar {
my ($xtops, $xtop) = @_;
$xtops->{char} = sub { ['a' .. 'z', '0' .. '9'] }
unless $xtops->{char};
my $instance = $xtop->{instance};
croak("\$xtop->{instance} not set for \$xtop->{id} = $xtop->{id}")
unless defined $instance;
my $char = &{$xtops->{char}}($instance);
if (ref $char) {
for my $c (@$char) {
$char = $c, last unless $xtops->{chars_in_use}{$c};
}
}
croak("no char matches instance '$instance'") unless defined $char;
$xtops->{chars_in_use}{$char} = 1;
$xtop->char($char);
$char;
}
# ----------------------------------------------------------------------
#10# sort
# assume chars chosen, as after update()
sub sort {
my $xtops = shift;
my $order = $xtops->{order}; # hashref char->integer
my $max = -1;
if ($order) {
for (values %$order) {
croak(
"values in order hash should be nonnegative integers," .
" not '$_'"
) unless /^\d+$/;
$max = $_ if $max < $_;
}
}
for my $n (0 .. 127) {
my $char = chr($n);
next if defined $order->{$char};
$order->{$char} = $max + 1 + $n;
}
@{$xtops->{sorted}} =
sort { $order->{$a->{char}} <=> $order->{$b->{char}} }
values %{$xtops->byid};
}
# ----------------------------------------------------------------------
#11# sorted
sub sorted {
my $xtops = shift;
$xtops->sort unless $xtops->{sorted};
$xtops->{sorted};
}
# ----------------------------------------------------------------------
#12# bychar
# assume chars chosen, as after update()
sub bychar {
my $xtops = shift;
my $bychar = {};
for my $xtop (values %{$xtops->byid}) {
$bychar->{$xtop->{char}} = $xtop;
}
$bychar;
}
# ----------------------------------------------------------------------
#13# X
sub X {
my $xtops = shift;
$xtops->{X};
}
# ----------------------------------------------------------------------
#14# match
sub match {
my ($xtops, $prop, $regex) = @_;
for my $xtop (values %{$xtops->{byid}}) {
my $value = $xtop->{$prop};
$value = eval "\$xtop->$prop" unless defined $value;
return $xtop if $value =~ $regex;
}
}
for my $sub (qw(class instance title icon char)) {
no strict 'refs';
*$sub = sub {
my ($xtops, $regex) = @_;
$xtops->match($sub, $regex);
}
}
# ----------------------------------------------------------------------
#15# active
# argument normally $xtops, but not used except to find this
sub active {
my $xtops = shift;
my $X = $xtops->{X};
my $root = $xtops->{root};
my $_NET_ACTIVE_WINDOW = $xtops->{_NET_ACTIVE_WINDOW};
my ($value, $type, $format, $bytes_after) =
$X->GetProperty($root, $_NET_ACTIVE_WINDOW, @getpropconst);
unpack('L*', $value);
}
# ----------------------------------------------------------------------
#16# stacking
# see raise & lower
# argument normally $xtops, but not used except to find this
sub stacking {
my $xtops = shift;
my $X = $xtops->{X};
my $root = $xtops->{root};
my $_NET_CLIENT_LIST_STACKING = $xtops->{_NET_CLIENT_LIST_STACKING};
my ($value, $type, $format, $bytes_after) =
$X->GetProperty($root, $_NET_CLIENT_LIST_STACKING, @getpropconst);
unpack('L*', $value);
}
# ----------------------------------------------------------------------
#17# gravity
sub NorthWest () { 1; }
sub North () { 2; }
sub NorthEast () { 3; }
sub West () { 4; }
sub Center () { 5; }
sub East () { 6; }
sub SouthWest () { 7; }
sub South () { 8; }
sub SouthEast () { 9; }
sub Gravity {
my $arg = shift;
$arg = shift if ref $arg;
return undef unless $arg =~ /^\d$/;
( undef,
qw(
NorthWest
North
NorthEast
West
Center
East
SouthWest
South
SouthEast
)
)[$arg];
}
# ----------------------------------------------------------------------
#18# monitor changes
# also X11::Top method
sub monitor_property_change {
my $xtops = shift;
my $X = $xtops->{X};
my $id = $xtops->{root};
$X->ChangeWindowAttributes(
$id,
event_mask => $X->pack_event_mask('PropertyChange')
);
}
# ----------------------------------------------------------------------
#19# X11::Top
package X11::Top;
use Data::Dumper;
sub id {
my $xtop = shift;
$xtop->{id}
}
# ----------------------------------------------------------------------
#20# instance
sub instance {
my $xtop = shift;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $WM_CLASS = $xtops->{WM_CLASS};
return $xtop->{instance} if defined $xtop->{instance};
my ($value, $type, $format, $bytes_after) =
$X->GetProperty($xtop->{id}, $WM_CLASS, @getpropconst);
my ($instance, $class) = split "\0", $value;
$xtop->{instance} = $instance;
$xtop->{class} = $class;
$instance;
}
# ----------------------------------------------------------------------
#21# class
sub class {
my $xtop = shift;
my $xtops = $xtop->{xtops};
return $xtop->{class} if defined $xtop->{class};
my $X = $xtops->{X};
my $WM_CLASS = $xtops->{WM_CLASS};
my ($value, $type, $format, $bytes_after) =
$X->GetProperty($xtop->{id}, $WM_CLASS, @getpropconst);
croak("failed to fetch WM_CLASS for window $xtop") unless $value;
my ($instance, $class) = split "\0", $value;
$xtop->{instance} = $instance;
$xtop->{class} = $class;
$class;
}
# ----------------------------------------------------------------------
#22# title
sub title {
my $xtop = shift;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $WM_NAME = $xtops->{WM_NAME};
my ($value, $type, $format, $bytes_after) =
$X->GetProperty($xtop->{id}, $WM_NAME, @getpropconst);
$value;
}
# ----------------------------------------------------------------------
#23# icon
sub icon {
my $xtop = shift;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $WM_ICON_NAME = $xtops->{WM_ICON_NAME};
my ($value, $type, $format, $bytes_after) =
$X->GetProperty($xtop->{id}, $WM_ICON_NAME, @getpropconst);
$value;
}
# ----------------------------------------------------------------------
#24# char
sub char {
my ($xtop, $char) = @_;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $_XCHAR_CHAR = $xtops->{_XCHAR_CHAR};
unless (defined $char) {
return $xtop->{char} if defined $xtop->{char};
my ($value, $type, $format, $bytes_after) =
$X->GetProperty($xtop->{id}, $_XCHAR_CHAR, @getpropconst);
return $xtop->{char} = $value;
}
$xtop->{char} = $char;
my $STRING = $xtops->{STRING};
$X->ChangeProperty(
$xtop->{id}, # window
$_XCHAR_CHAR, # property
$STRING, # type
8, # format
'Replace', # mode
$char, # data
);
}
# ----------------------------------------------------------------------
#25# command
sub command {
my ($xtop, $command) = @_;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $_XCHAR_COMMAND = $xtops->{_XCHAR_COMMAND};
my $STRING = $xtops->{STRING};
unless (defined $command) {
my ($value, $type, $format, $bytes_after) =
$X->GetProperty($xtop->{id}, $_XCHAR_COMMAND, @getpropconst);
return $value;
}
$X->ChangeProperty(
$xtop->{id}, # window
$_XCHAR_COMMAND, # property
$STRING, # type
8, # format
'Replace', # mode
$command, # data
);
}
# ----------------------------------------------------------------------
#26# monitor changes
# also X11::Tops method
sub monitor_property_change {
my $xtop = shift;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $id = $xtop->{id};
$X->ChangeWindowAttributes(
$id,
event_mask => $X->pack_event_mask('PropertyChange')
);
}
sub monitor_property_and_visibility_change {
my $xtop = shift;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $id = $xtop->{id};
$X->ChangeWindowAttributes(
$id,
event_mask =>
$X->pack_event_mask('PropertyChange', 'VisibilityChange')
);
}
# doesn't work with fvwm [+taskbar3] or twm [+taskbar4] ...
sub monitor_property_and_structure_change {
my $xtop = shift;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $id = $xtop->{id};
$X->ChangeWindowAttributes(
$id,
event_mask =>
$X->pack_event_mask('PropertyChange', 'SubstructureNotifyMask')
);
}
sub attributes {
my $xtop = shift;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $id = $xtop->{id};
$X->GetWindowAttributes($id); # %attributes
}
# ----------------------------------------------------------------------
#27# raise & lower
# see stacking
sub raise {
my $xtop = shift;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $id = $xtop->{id};
$X->MapWindow($id);
$X->ConfigureWindow($id, stack_mode => 'Above');
}
# if call $xtop->geometry then mouse & focus often don't move ...
sub raise_and_focus {
my $xtop = shift;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $id = $xtop->{id};
$X->MapWindow($id);
$X->ConfigureWindow($id, stack_mode => 'Above');
my %geometry = $X->GetGeometry($id);
my $x = int($geometry{width} / 2);
my $y = int($geometry{height} / 2);
$X->WarpPointer('None', $id, 0, 0, 0, 0, $x, $y);
$X->SetInputFocus($id, 'RevertToPointerRoot', 'CurrentTime');
}
sub lower {
my $xtop = shift;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $id = $xtop->{id};
$X->ConfigureWindow($id, stack_mode => 'Below');
}
# ----------------------------------------------------------------------
#28# geometry
sub geometry {
my $xtop = shift;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $id = $xtop->{id};
my %geom = $X->GetGeometry($id);
my ($root2, $parent, @kids) = $X->QueryTree($id);
my ($same_screen, $child, $x, $y) =
$X->TranslateCoordinates($parent, $root2, $geom{x}, $geom{y});
return ($geom{width}, $geom{height}, $x, $y);
}
# ----------------------------------------------------------------------
#29# frame_geometry
sub frame_geometry {
my $xtop = shift;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $frame = $xtop->{id};
while (1) {
my ($root2, $parent, @kids) = $X->QueryTree($frame);
last if $parent == $root2;
$frame = $parent;
}
my %geom = $X->GetGeometry($frame);
($geom{width}, $geom{height}, $geom{x}, $geom{y});
}
# ----------------------------------------------------------------------
#30# wm_normal_hints
our @wm_normal_hints = qw(
flags
user_x user_y user_w user_h
min_width min_height
max_width max_height
width_inc height_inc
min_aspect_num min_aspect_den
max_aspect_num max_aspect_den
base_width base_height
gravity
);
my @wm_normal_hints_flags = (
[qw(user_x user_y)], # USPosition
[qw(user_w user_h)], # USSize
[], # PPosition
[], # PSize
[qw(min_width min_height)], # PMinSize
[qw(max_width max_height)], # PMaxSize
[qw(width_inc height_inc)], # PResizeInc
[qw(min_aspect_num min_aspect_den
max_aspect_num max_aspect_den)], # PAspect
[qw(base_width base_height)], # PBaseSize
[qw(gravity)], # PWinGravity
);
sub wm_normal_hints {
my $xtop = shift;
my $xtops = $xtop->{xtops};
my $X = $xtops->{X};
my $WM_NORMAL_HINTS = $xtops->{WM_NORMAL_HINTS};
my $WM_SIZE_HINTS = $xtops->{WM_SIZE_HINTS};
my %wm_normal_hints = @_;
if (%wm_normal_hints) {
my $value =
pack('L*', map { $wm_normal_hints{$_} || 0 } @wm_normal_hints);
$X->ChangeProperty(
$xtop->{id}, # window
$WM_NORMAL_HINTS, # property
$WM_SIZE_HINTS, # type
32, # format
'Replace', # mode
$value # data
);
return;
}
my ($value, $type, $format, $bytes_after) =
$X->GetProperty($xtop->{id}, $WM_NORMAL_HINTS, @getpropconst);
my %xxx;
@xxx{@wm_normal_hints} = unpack('L*', $value);
my $flags = $wm_normal_hints{flags} = $xxx{flags};
for my $i (@wm_normal_hints_flags) {
$wm_normal_hints{$_} = $flags & 1 ? $xxx{$_} : undef for @$i;
$flags >>= 1;
}
%wm_normal_hints
}
# ----------------------------------------------------------------------
#31# parse_geometry
sub parse_geometry {
my ($xtop, $geometry) = @_;
my $X = $xtop->{xtops}{X};
my ($w, $h, $x, $y) =
$geometry =~ /^(\d+)x(\d+)([+-]-?\d+)([+-]-?\d+)$/;
my $g; # gravity
my $screenwidth = $X->width_in_pixels;
my $screenheight = $X->height_in_pixels;
if ($w == 0 || $h == 0 || $x eq '00' || $y eq '00') {
my %xtop;
@xtop{qw(w h x y)} = $xtop->geometry;
$w = $xtop{w} if $w == 0;
$h = $xtop{h} if $h == 0;
$x = $xtop{x} if $x eq '00';
$y = $xtop{y} if $y eq '00';
}
if (my ($a) = $x =~ /^-\+?(-?\d+)/) {
if (my ($b) = $y =~ /^-\+?(-?\d+)/) {
$g = X11::Tops::SouthEast;
$x = $screenwidth - $w - $a;
$y = $screenheight - $h - $b;
} else {
$g = X11::Tops::NorthEast;
$x = $screenwidth - $w - $a;
$y =~ s/^\+//;
$y = 0 + $y;
}
} else {
if (my ($b) = $y =~ /^-\+?(-?\d+)/) {
$g = X11::Tops::SouthWest;
$x =~ s/^\+//;
$x = 0 + $x;
$y = $screenheight - $h - $b;
} else {
$g = X11::Tops::NorthWest;
$x =~ s/^\+//;
$y =~ s/^\+//;
$x = 0 + $x;
$y = 0 + $y;
}
}
($w, $h, $x, $y, $g);
}
# ----------------------------------------------------------------------
#32# requested geometry
sub requested_geometry {
my $xtop = shift;
my %geometry;
@geometry{qw(w h x y)} = $xtop->geometry;
my %frame_geometry;
@frame_geometry{qw(w h x y)} = $xtop->frame_geometry;
my %wm_normal_hints = $xtop->wm_normal_hints;
my $gravity = $wm_normal_hints{gravity};
my $w = $geometry{w};
my $h = $geometry{h};
my $x =
$gravity == X11::Tops::NorthWest || $gravity == X11::Tops::SouthWest ?
$frame_geometry{x} :
$gravity == X11::Tops::NorthEast || $gravity == X11::Tops::SouthEast ?
$frame_geometry{x} - $frame_geometry{w} + $geometry{w} :
croak("unknown gravity '$gravity'");
my $y =
$gravity == X11::Tops::NorthWest || $gravity == X11::Tops::NorthEast ?
$frame_geometry{y} :
$gravity == X11::Tops::SouthEast || $gravity == X11::Tops::SouthWest ?
$frame_geometry{y} - $frame_geometry{h} + $geometry{h} :
croak("unknown gravity '$gravity'");
($w, $h, $x, $y, $gravity);
}
# ----------------------------------------------------------------------
#33# move
# +taskbar7
sub move {
my ($xtop, $geometry) = @_; # (src, dst)
my $X = $xtop->{xtops}{X};
my %src_wm_normal_hints = $xtop->wm_normal_hints;
my %dst;
@dst{qw(w h x y g)} = $xtop->parse_geometry($geometry);
my %dst_wm_normal_hints = %src_wm_normal_hints;
$dst_wm_normal_hints{gravity} = $dst{g};
$xtop->wm_normal_hints(%dst_wm_normal_hints);
$X->ConfigureWindow(
$xtop->{id},
width => $dst{w}, height => $dst{h},
x => $dst{x}, y => $dst{y}
);
}
# ----------------------------------------------------------------------
#34# expand
# +taskbar[78]
sub expand {
my ($xtop, $geometry) = @_; # (src, dst)
my $X11 = $xtop->{xtops}{X};
my %src;
@src{qw(w h x y g)} = $xtop->requested_geometry;
$src{X} = $src{x} + $src{w};
$src{Y} = $src{y} + $src{h};
my %dst;
@dst{qw(w h x y g)} = $xtop->parse_geometry($geometry);
$dst{X} = $dst{x} + $dst{w};
$dst{Y} = $dst{y} + $dst{h};
my $x = $src{x} < $dst{x} ? $src{x} : $dst{x};
my $y = $src{y} < $dst{y} ? $src{y} : $dst{y};
my $X = $src{X} > $dst{X} ? $src{X} : $dst{X};
my $Y = $src{Y} > $dst{Y} ? $src{Y} : $dst{Y};
my $w = $X - $x;
my $h = $Y - $y;
my %wm_normal_hints = $xtop->wm_normal_hints;
my %base;
$base{w} = $wm_normal_hints{base_width};
$base{h} = $wm_normal_hints{base_height};
my %inc;
$inc{w} = $wm_normal_hints{width_inc};
$inc{h} = $wm_normal_hints{height_inc};
if ($inc{w} && $inc{h}) {
$w += ($base{w} - $w) % $inc{w};
$h += ($base{h} - $h) % $inc{h};
}
$wm_normal_hints{gravity} = X11::Tops::NorthWest;
$wm_normal_hints{user_w} = $w;
$wm_normal_hints{user_h} = $h;
$wm_normal_hints{user_x} = $x;
$wm_normal_hints{user_y} = $y;
$wm_normal_hints{max_width} = $w;
$wm_normal_hints{max_height} = $h;
$xtop->wm_normal_hints(%wm_normal_hints);
$X11->ConfigureWindow($xtop->{id},
width => $w,
height => $h,
x => $x,
y => $y
);
}
# ----------------------------------------------------------------------
1;
__END__
#35# notes
# 1.13
# moved reading of .xls to here from gen/xls
# changed sort method
# _XLS_CHAR getting less interesting
# +taskbar3
# 1.16
# $xtops->active
# 1.18
# xls instance name
# 1.23
# lower()
# 1.24
# initial clients work with twm (but not later clients) [+taskbar4]
# 1.32
# geometry()
# 1.33
# frame_geometry()
# wm_normal_hints()
# 1.37
# move() [+taskbar7]
# 1.42
# uses Xtops1.pm [+taskbar7]
# 2.1
# +taskbar7
# 3.1
# +taskbar7
# doesn't work yet
# 3.16
# changed _XLS_ to _XCHAR_
# $Revision: 3.25 $
# ----------------------------------------------------------------------
#36# pod
=head1 NAME
X11::Tops - handle top level X windows
=head1 WARNING
The high level part of the interface is currently (xchar 0.2) clumsy,
and will probably be changed.
=head1 SYNOPSIS
use X11::Tops;
$xtops = X11::Tops->new;
use X11::Tops;
$X = X11::Protocol->new;
$xtops = X11::Tops->new($X);
$xtops->update;
for $xtop (@{$xtops->sorted}) {
print join("\t",
$xtop->class, $xtop->instance, $xtop->title, $stop->icon
),
"\n"
}
$xtop = $xtops->match('instance', qr/gecko/i);
$xtop = $xtops->instance(qr/gecko/i);
$xtop = $xtops->icon(qr/apod/i);
$xtop->char('q');
$xtop->char;
@deleted = $xtops->update; # list of X ids
$xtops->monitor_property_change;
$xtop->monitor_property_change
=head1 DESCRIPTION
X11:Tops handles all the top level windows reported by the window
manager via the root window _NET_CLIENT_LIST property. Most of the
methods are general, but there's also support for the xchar(1) system
(which is currently insufficiently separated from the general methods).
It is built on top of the X11::Protocol module.
It's designed to handle long-lived programs that keep track of changes
in the population of top level windows (such as xtb(1)) and short-lived
programs that just want a snapshot (such as xup(1) and xmv(1)).
An X11::Tops object C<$xtops> contains a set of X11::Top objects
C<$xtop>. The latter can be reached with several methods of the former:
$xtops->sorted returns a reference to an array of $xtop
$xtops->byid returns a hashref, each value an $xtop
$xtops->bychar returns a hashref, each value an $xtop
The construction of $xtops can take one or several steps, and can be partial
or complete. As mentioned in the warning above, this is currently clumsy.
The following constructs it completely:
$xtops = X11::Tops->new;
$xtops->update;
This fetches all (toplevel) window ids and all their WM_CLASS properties,
calculating a character for each & setting the _XCHAR_CHAR property on
it accordingly.
The following also constructs it completely:
$xtops = X11::Tops->new;
$xtops->update_from_props;
the difference being that the per-window characters aren't computed
as above but fetched from the _XCHAR_CHAR propertes.
The construction used by the C<update> method above uses a hardwired
algorithm for assigning characters to windows. The algorithm can
instead be flexibly specified:
$xtops = X11::Tops->new;
$xtops->{char} = sub { $instance = shift; ...; return $char; };
$xtops->update;
The C<sort> method mentioned above uses a hardwired sort algorithm that
can be over-ridden:
$xtops = X11::Tops->new;
$xtops->{char} = sub { $instance = shift; ...; return $char; };
$xtops->update;
$xtops->{order} = ['a' .. 'z', 0 .. 9, 'A' .. 'Z'];
@xtops = $xtops->sort;
Partial construction, as for snapshotting, is typically:
$xtops = X11::Tops->new->update_ids;
for $xtop (values %{$xtops->byid}) { ... }
Both X11::Tops and X11::Top have class, instance, title & icon methods.
They only get, not set. For X11::Tops there is a regex argument & the
method returns an X11::Top object whose corresponding property matches
the regex. For X11::Top there is no argument (other than the object) &
the corresponding property is returned. Class & instance are handled
separately even though they come from the same property (WM_CLASS).
Values of class & instance are assumed not to change (so are cached).
The X11::Top method C<char> gets or sets a (non-standard) property
_XCHAR_CHAR. Normally the character name of a toplevel is derived from
the instance name via $xtops->{char} as above.
=head1 OTHER X11::Xtops METHODS
=over
=item X()
returns the associated X11::Protocol object
=item active()
returns the X id of the active window
=item stacking()
returns the array of X ids in stacking order (bottom first)
=item monitor_property_change()
asks for root PropertyChange events
=back
=head1 OTHER X11::Xtop METHODS
=over
=item command()
gets or sets the _XCHAR_COMMAND property
=item attributes()
X11::Protocol::GetWindowAttributes
=item raise()
=item raise_and_focus()
=item lower()
=item geometry()
=item frame_geometry()
=item wm_normal_hints()
=item parse_geometry()
=item requested_geometry()
=item move()
=item expand()
=item monitor_property_change()
asks for PropertyChange events
=item monitor_property_and_visibility_change()
asks for PropertyChange & VisibilityChange events
=item monitor_property_and_structure_change()
asks for PropertyChange & SubstructureNotifyMask events
=back
=head1 AUTHOR
Brian Keck E<lt>bwkeck@gmail.comE<gt>
=head1 VERSION
$Source: /home/keck/lib/perl/X11/RCS/Tops.pm,v $
$Revision: 3.25 $
$Date: 2007/07/07 07:52:11 $
xchar 0.2
=cut