view release on metacpan or  search on metacpan

lib/X11/korgwm/Window.pm  view on Meta::CPAN

        $value = [ unpack 'L' x $prop->{value_len}, $value ] if $prop_type eq 'ATOM';
    }

    return wantarray ? ($value, $prop) : $value;
}

sub _resize_and_move($wid, $x, $y, $w, $h, $bw=$cfg->{border_width}) {
    my $mask = CONFIG_WINDOW_X | CONFIG_WINDOW_Y | CONFIG_WINDOW_WIDTH | CONFIG_WINDOW_HEIGHT |
        CONFIG_WINDOW_BORDER_WIDTH;
    $X->configure_window($wid, $mask, $x, $y, $w - 2 * $bw, $h - 2 * $bw, $bw);
}

sub _move($wid, $x, $y) {
    $X->configure_window($wid, CONFIG_WINDOW_X | CONFIG_WINDOW_Y, $x, $y);
}

sub _resize($wid, $w, $h) {
    $X->configure_window($wid, CONFIG_WINDOW_WIDTH | CONFIG_WINDOW_HEIGHT, $w, $h);
}

sub _configure_notify($wid, $sequence, $x, $y, $w, $h, $above_sibling=0, $override_redirect=0,
        $bw=$cfg->{border_width}) {
    return carp "Undefined ($x, $y, $w, $h) for configure notify" unless 4 == grep defined, $x, $y, $w, $h;
    my $packed = pack('CCSLLLssSSSC', CONFIGURE_NOTIFY, 0, $sequence,
        $wid, # event
        $wid, # window
        $above_sibling, $x, $y, $w, $h, $bw, $override_redirect);
    $X->send_event(0, $wid, EVENT_MASK_STRUCTURE_NOTIFY, $packed);
}

sub _attributes($wid) {
    $X->get_window_attributes_reply($X->get_window_attributes($wid)->{sequence});
}

sub _class($wid) {
    my @class = split /\0/, scalar _get_property($wid, "WM_CLASS", "STRING", 16) // return;
    return wantarray ? @class : $class[0];
}

sub _title($wid) {
    # long_length is a 32-bit multiplies of data; UTF8 usually encodes a char up to 8 bytes, so multipler is 2:
    my $title = _get_property($wid, "_NET_WM_NAME", "UTF8_STRING", 2 * $cfg->{title_max_len});
    $title = _get_property($wid, "WM_NAME", "STRING", $cfg->{title_max_len}) unless length $title;
    return "" unless defined $title;
    $title =~ s/\n/ /g;
    $title =~ s/ *$//g;
    $title =~ s/^ *//g;
    $title =~ s/\p{Grapheme_Extend}/?/g;
    $title;
}

sub _transient_for($wid) {
    _get_property($wid, "WM_TRANSIENT_FOR", "WINDOW", 16);
}

sub _query_geometry($wid) {
    map { @{$_}{qw( x y width height )} } $X->get_geometry_reply($X->get_geometry($wid)->{sequence});
}

# Generate accessors by object
UNITCHECK {
    no strict 'refs';
    for my $func (qw(
        attributes
        class
        configure_notify
        get_property
        query_geometry
        title
        transient_for
        )) {
        *{__PACKAGE__ . "::$func"} = sub {
            my $self = shift;
            croak "Undefined window" unless $self->{id};
            "_$func"->($self->{id}, @_);
        };
    }
}

sub resize_and_move($self, $x, $y, $w, $h, $bw=$cfg->{border_width}) {
    croak "Undefined window" unless $self->{id};
    DEBUG8 and carp "resize_and_move($self, $x, $y, $w, $h, $bw)";
    @{ $self }{qw( real_x real_y real_w real_h real_bw )} = ($x, $y, $w, $h, $bw);
    _resize_and_move($self->{id}, $x, $y, $w, $h, $bw);
}

sub move($self, $x, $y) {
    croak "Undefined window" unless $self->{id};
    @{ $self }{qw( real_x real_y )} = ($x, $y);
    $X->configure_window($self->{id}, CONFIG_WINDOW_X | CONFIG_WINDOW_Y, $x, $y);
}

sub resize($self, $w, $h) {
    croak "Undefined window" unless $self->{id};
    @{ $self }{qw( real_w real_h )} = ($w, $h);
    $X->configure_window($self->{id}, CONFIG_WINDOW_WIDTH | CONFIG_WINDOW_HEIGHT, $w, $h);
}

# Move floating windows between screens
sub floating_move_screen($self, $old_screen, $new_screen) {
    return unless $self->{floating};

    my ($new_x, $new_y) = @{ $self }{qw( real_x real_y )};
    $new_x -= $old_screen->{x};
    $new_y -= $old_screen->{y};
    $new_x += $new_screen->{x};
    $new_y += $new_screen->{y};
    $self->move($new_x, $new_y);

    # Fix configured geometry after it was modified by move()
    @{ $self }{qw( x y )} = @{ $self }{qw( real_x real_y )};
}

# Put the window above others
sub _stack_above($self) {
    return if $self->{_hidden};
    $X->configure_window($self->{id}, CONFIG_WINDOW_STACK_MODE, STACK_MODE_ABOVE);
}

# Put the window below another ($top)
sub _stack_below($self, $top) {