view release on metacpan or  search on metacpan

lib/Desktop/XWindowManager/Util.pm  view on Meta::CPAN

        with_kde_activity => {
            summary => 'Show KDE activity GUID for each window (old name for with_kde_activity_guid)',
            schema => 'bool*',
        },
        with_kde_activity_guid => {
            summary => 'Show KDE activity GUID for each window',
            schema => 'bool*',
        },
        with_kde_activity_name => {
            summary => 'Show KDE activity name for each window',
            schema => 'bool*',
        },
    },
    deps => {
        prog => 'wmctrl',
    },
};
sub list_xwm_windows {
    my %args = @_;

    my $with_kde_activity =
        $args{with_kde_activity} ||
        $args{with_kde_activity_guid} ||
        $args{with_kde_activity_name} ||
        ($args{kde_activity_name} && @{$args{kde_activity_name}}) ||
        $args{current_kde_activity};
    my $detail = $args{detail};
    $detail //=1 if $with_kde_activity;

    my @rows;
    system({capture_stdout => \my $stdout}, "wmctrl", "-lpG");
    return [500, "Can't run wmctrl"] if $?;

    my @positive_query;
    my @negative_query;
  BUILD_QUERY: {
        for my $query (@{ $args{query} // [] }) {
            if ($query =~ /\A-(.*)/) {
                my $q = $1;
                push @negative_query, sub { $_[0] =~ /\Q$q\E/i ? 1 : 0 };
            } elsif ($query =~ m!\A/(.*)/\z!) {
                my $re = $1;
                push @positive_query, sub { $_[0] =~ /$re/i ? 1 : 0 };
            } else {
                push @positive_query, sub { $_[0] =~ /\Q$query\E/i ? 1 : 0 };
            }
        }
    } # BUILD_QUERY

    my $res_list_kact;
    if ($with_kde_activity) {
        require Desktop::KDEActivity::Util;
        $res_list_kact = Desktop::KDEActivity::Util::list_kde_activities(detail=>1);
        return [500, "Can't list KDE activities: $res_list_kact->[0] - $res_list_kact->[1]"]
            unless $res_list_kact->[0] == 200;
    }

    my $current_kde_activity;
  LINE:
    for my $line (split /^/m, $stdout) {
        my ($id, $desktop, $pid,
            $x, $y, $width, $height,
            $host, $title) = $line =~ /^(\S+)\s+(\S+)\s+(\d+)\s+
                                       (\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+
                                       (\S+)\s+(.*)/x;
        my $row = {
            id => $id,
            desktop => $desktop,
            pid => $pid,
            x => $x,
            y => $y,
            width => $width,
            height => $height,
            host => $host,
            title => $title,
        };

      GET_KDE_ACTIVITY: {
            last unless $with_kde_activity;
            my $res_get_act = get_xwm_window_kde_activity(id => $row->{id});
            if ($res_get_act->[0] != 200) {
                log_warn "Can't get KDE activity for window id %s: %d - %s", $row->{id}, $res_get_act->[0], $res_get_act->[1];
                last;
            }
            my $guids = $res_get_act->[2];
            my @guids = $guids ? (split /,/, $guids) : ();
            my $name;
            for my $row (@{ $res_list_kact->[2] }) {
                if (grep { $_ eq $row->{guid} } @guids) {
                    $name = defined($name) ?
                        (ref($name) eq 'ARRAY' ? [@$name, $row->{name}] : [$name, $row->{name}]) :
                        $row->{name};
                }
            }
            $row->{kde_activity_guid} = $guids if $args{with_kde_activity} || $args{with_kde_activity_guid};
            $row->{kde_activity_name} = $name if $args{with_kde_activity_name} || $args{kde_activity_name} || $args{current_kde_activity};
        }

      FILTER: {
          ID: {
                last unless defined $args{id};
                next LINE unless $row->{id} eq $args{id};
            } # ID

          KDE_ACTIVITY: {
                my @win_kde_activities = !defined($row->{kde_activity_name}) ? () :
                    ref($row->{kde_activity_name}) eq 'ARRAY' ? @{$row->{kde_activity_name}} :
                    ($row->{kde_activity_name});
                if ($args{current_kde_activity}) {
                    unless (defined $current_kde_activity) {
                        require Desktop::KDEActivity::Util;
                        my $res = Desktop::KDEActivity::Util::get_current_kde_activity();
                        return [500, "Can't get current KDE activity: $res->[0] - $res->[1]"]
                            unless $res->[0] == 200;
                        $current_kde_activity = $res->[2];
                    }
                    next LINE unless any { $_ eq $current_kde_activity } @win_kde_activities;
                } elsif ($args{kde_activity_name} && @{ $args{kde_activity_name} }) {
                    next LINE unless any {
                        my $k = $_;
                        any { $k eq $_ } @{ $args{kde_activity_name} };
                    } @win_kde_activities;
                }
            } # KDE_ACTIVITY

          NEGATIVE_QUERY: {
                last unless @negative_query;
                my $match = 1;

lib/Desktop/XWindowManager/Util.pm  view on Meta::CPAN

        [200];
    },
);

gen_modified_sub(
    output_name => 'move_windows_to_this_kde_activity',
    base_name => 'move_windows_to_kde_activity',
    die => 1,
    summary => 'Move matching window(s) to the current KDE activity',
    description => <<'MARKDOWN',

A simple wrapper for `move_windows_to_kde_activity`, where windows will be moved
to the current KDE activity.

MARKDOWN
    delete_args => [
        'activity_name',
        'all_activities',
    ],
    wrap_code => sub {
        my $orig = shift;
        my %args = @_;

        require Desktop::KDEActivity::Util;
        my $res = Desktop::KDEActivity::Util::get_current_kde_activity();
        return [500, "Can't get current KDE activity: $res->[0] - $res->[1]"]
            unless $res->[0] == 200;
        my $activity_name = $res->[2];

        $orig->(%args, activity_name => $activity_name);
    },
);

1;
# ABSTRACT: Utilities related to X Window Manager

__END__

=pod

=encoding UTF-8

=head1 NAME

Desktop::XWindowManager::Util - Utilities related to X Window Manager

=head1 VERSION

This document describes version 0.005 of Desktop::XWindowManager::Util (from Perl distribution Desktop-XWindowManager-Util), released on 2026-05-18.

=head1 SYNOPSIS

=head1 DESCRIPTION

This distribution includes routines related to "X Window Manager".

Under the hood, it's currently a wrapper to tools like C<wmctrl>, etc.

C<wmctrl> works on EWMH-compliant X11 window managers. This means mainstream
desktop environments like KWin, Xfwm, Mutter (GNOME). It works partially or
doesn't work with minimalist window managers like dwm, suckless. It partially
works with Wayland where there is an X compatibility layer, e.g. GNOME Wayland,
KDE Plasma Wayland.

=head1 FUNCTIONS


=head2 get_xwm_window_kde_activity

Usage:

 get_xwm_window_kde_activity(%args) -> [$status_code, $reason, $payload, \%result_meta]

Get the KDE activity GUID(s) of a specific window.

A window can be displayed in more than one KDE activities, so this utility can
return a comma-separated list of GUIDs.

This function is not exported.

Arguments ('*' denotes required arguments):

=over 4

=item * B<id>* => I<str>

Window ID, specified in hex form with 0x prefix, e.g. 0x05a0000e.


=back

Returns an enveloped result (an array).

First element ($status_code) is an integer containing HTTP-like status code
(200 means OK, 4xx caller error, 5xx function error). Second element
($reason) is a string containing error message, or something like "OK" if status is
200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
element (%result_meta) is called result metadata and is optional, a hash
that contains extra information, much like how HTTP response headers provide additional metadata.

Return value:  (any)



=head2 list_xwm_windows

Usage:

 list_xwm_windows(%args) -> [$status_code, $reason, $payload, \%result_meta]

List all Windows.

This utility is currently a wrapper for L<wmctrl>.

This function is not exported by default, but exportable.

Arguments ('*' denotes required arguments):

=over 4