# $Source: /home/keck/lib/perl/X11/RCS/Tops.pm,v $
# $Revision: 3.19 $$Date: 2007/07/01 14:48:29 $
# 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;

# ----------------------------------------------------------------------

#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};
  unless ($order) {
    my $n = 0;
    $order->{$_} = $n++ for 'a' .. 'z', '0' .. '9';
  }
  @{$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 name 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.19 $

# ----------------------------------------------------------------------

#36# pod

=head1 NAME

X11::Tops

=head1 SYNOPSIS

  use X11::Tops;
  $xtops = X11::Tops->new;

  use X11::Tops;
  $X = X11::Protocol->new;
  $xtops = X11::Tops->new($X);
  @xtops = X11::Tops->new($X)->sort;

  print $xtops->[0]->class, "\n";
  print $xtops->[0]->instance, "\n";
  print $xtops->[0]->icon, "\n";
  print $xtops->[0]->title, "\n";

  for my $xtop (@$xtops) { print $xtop->instance, "\n" }

  $xtop = $xtops->match('instance', qr/gecko/i);
  $xtop = $xtops->instance(qr/gecko/i);
  $xtop = $xtops->icon(qr/gecko/i);

  $xtop->char('q');
  $xtop->char;

  ($xtops, @deleted) = $xtops->update;

  $xtop->monitor_property_change
  X11::Top::monitor_property_change($X->root);

=head1 DESCRIPTION

An X11::Tops object is an array of X11::Top objects.

Both classes have class, instance, title & icon methods.  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.

=head1 RCS

 $Source: /home/keck/lib/perl/X11/RCS/Tops.pm,v $
 $Revision: 3.19 $
 $Date: 2007/07/01 14:48:29 $

=cut

