#!/usr/bin/env perl
# i3status-wrapper -- wrapper for i3status(1), plus other monitoring
#
# Copyright (C) 2019, 2021-2024 Sean Whitton
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
use 5.032;
use strict;
use warnings;
use lib "$ENV{HOME}/src/dotfiles/perl5";
use JSON;
use IO::Pipe;
use IPC::Shareable ":lock";
use Local::Desktop::WMIPC;
use Sys::Hostname;
use POSIX "floor", "mkfifo";
use File::Basename "basename", "dirname";
use File::Spec::Functions "catfile";
use List::Util qw(first min max);
$| = 1;
my $pipe = IO::Pipe->new;
my $i3status = fork // die "couldn't fork()!";
unless ($i3status) {
$pipe->writer;
open STDOUT, ">&=", $pipe->fileno
or die "couldn't open child's STDOUT";
exec "i3status";
}
tie my %info, "IPC::Shareable", undef, { destroy => 1 };
my $wmipc = Local::Desktop::WMIPC->new;
sub with_ignored_events (&) {
$wmipc->send_tick("i3status-wrapper-ign");
$_[0]->();
$wmipc->send_tick("i3status-wrapper-unign");
}
my @all_workspaces = (
"1", "2", "3", "4", "5", "6",
"7", "8", "9", "10", "11:F1", "12:F2",
"13:F3", "14:F4", "15:F5", "16:F6", "17:F7", "18:F8",
"19:F9", "20:F10", "21:F11", "22:F12"
);
unless (fork // warn "couldn't fork monitoring loop") {
my $events = Local::Desktop::WMIPC->new;
$events->subscribe(qw(tick window workspace));
# Determine the initial state -- the WM might just have been reloaded.
# Move any previously-hidden containers to a fresh workspace for perusal.
tied(%info)->lock;
my @old_ids;
for ($wmipc->get_workspaces->@*) {
$info{focused_ws} = $_->{id} if $_->{focused};
push @old_ids, $1 if $_->{name} =~ /\A\*(\d+)\*\z/;
}
if (@old_ids) {
fresh_workspace(go => 1);
$wmipc->cmd(
map("[con_id=$_] move container workspace current", @old_ids),
"focus child");
}
my @trees = $wmipc->get_tree;
while (@trees) {
foreach my $node ((shift @trees)->{nodes}->@*) {
if ($node->{type} eq "workspace"
&& grep $_ eq $node->{name}, @all_workspaces) {
my $entry = $info{paper_ws}{$node->{id}}
//= { name => $node->{name},
off_left => [], off_right => [] };
sync_cols($node => $entry);
$entry->{ncols} = max 2, scalar $entry->{cols}->@*;
} elsif (grep $_ eq "caffeinated", $node->{marks}->@*) {
register_caffeinated($node);
}
unshift @trees, $node;
}
}
tied(%info)->unlock;
# Now loop forever reading events, assuming no exceptions.
eval {
while (my $e = <$events>) {
state $last_e;
tied(%info)->lock;
# New containers
if ($last_e && $last_e->{change} && $last_e->{change} eq "new") {
normalise_ws_cols()
unless $e->{change} && $e->{change} eq "floating";
undef $last_e;
} elsif ($e->{change} && $e->{change} eq "new"
&& exists $info{paper_ws}{$info{focused_ws}}) {
# We have to go round the loop once more to find out if it's
# just a floating dialog that we'll ignore.
$last_e = $e;
} elsif ($e->{change} && exists $info{paper_ws}{$info{focused_ws}}
&& $e->{change} eq "floating"
&& $e->{container}{type} ne "floating_con") {
# A container stopped floating -- it's as though it's new.
normalise_ws_cols();
kill USR1 => $i3status;
}
# Other container changes
elsif ($e->{change} && exists $info{paper_ws}{$info{focused_ws}}
&& ($e->{change} eq "close"
|| $e->{change} eq "focus"
|| $e->{change} eq "move"
&& $e->{container} && $e->{container}{type} eq "con"
|| $e->{change} eq "floating"
&& $e->{container}{type} eq "floating_con")) {
# Generally we seek to update $info{paper_ws} with the
# information we receive by subscription, but in some cases we
# can't be sure of what has happened.
# For example, as we don't maintain a representation of the
# whole tree, on a change=move event, we don't know where the
# container has gone. Or a focus change might be due to a new
# container, in which case we might need to push one off.
normalise_ws_cols();
kill USR1 => $i3status;
}
# Ticks
elsif ($e->{payload} && $e->{payload} eq "i3status-wrapper-ign") {
# Ignore everything until tick telling us to unignore.
# Forked child that sent the ignore is responsible for
# updating data structures in the meantime.
while (my $next = <$events>) {
last if $next->{payload}
&& $next->{payload} eq "i3status-wrapper-unign";
}
}
# Workspace changes
elsif ($e->{change} && $e->{change} eq "focus" && $e->{current}) {
$info{focused_ws} = $e->{current}{id};
# Must normalise in case containers have moved to or from here
# in our absence.
normalise_ws_cols()
if exists $info{paper_ws}{$info{focused_ws}};
kill USR1 => $i3status;
} elsif ($e->{change} && $e->{change} eq "init" && $e->{current}
&& grep $_ eq $e->{current}{name}, @all_workspaces) {
$info{paper_ws}{$e->{current}{id}}
= { name => $e->{current}{name}, ncols => 2, cols => [],
off_left => [], off_right => [], };
} elsif ($e->{change} && $e->{change} eq "rename"
&& exists $info{paper_ws}{$e->{current}{id}}) {
$info{paper_ws}{$e->{current}{id}}{name}
= $e->{current}{name};
kill USR1 => $i3status;
} elsif ($e->{change} && $e->{change} eq "empty"
&& $e->{current}) {
delete $info{paper_ws}{$e->{current}{id}};
kill USR1 => $i3status;
}
# Mark changes
elsif ($e->{change} && $e->{change} eq "mark") {
if (grep $_ eq "caffeinated", $e->{container}{marks}->@*) {
register_caffeinated($e->{container});
} elsif ($info{caffeinated_id}
and $info{caffeinated_id} == $e->{container}{id}) {
clear_caffeinated();
}
}
tied(%info)->unlock;
}
};
# Give up if there's a decoding error. We can't ignore the problem
# because we don't want our ideas regarding what workspaces there are, and
# whether anything is caffeinated, to get out of sync.
#
# The user can use the WM's "reload" command to restart this loop.
$@ and wsbuttons("yes"), clear_caffeinated();
}
my $wm_ipc_socket = $ENV{SWAYSOCK} || $ENV{I3SOCK};
(basename $wm_ipc_socket) =~ /\d[\d.]*\d/;
my $cmdpipe = catfile dirname($wm_ipc_socket), "i3status-wrapper.$&.pipe";
-e and unlink for $cmdpipe;
unless (fork // warn "couldn't fork command pipe reader") {
mkfifo $cmdpipe, 0700 or die "mkfifo $cmdpipe failed: $!";
open my $cmdpipe_r, "<", $cmdpipe;
# Hold the pipe open with a writer that won't write anything.
open my $cmdpipe_w, ">", $cmdpipe;
while (my $cmd = <$cmdpipe_r>) {
tied(%info)->lock;
my $ws = $info{paper_ws}{$info{focused_ws}};
my $cols = $ws->{cols};
my $i = first { $cols->[$_] == $ws->{focused_col} } 0..$#$cols;
state $last_dir = 1;
my $mv = sub {
my ($j, $move) = @_;
if (@$cols > $j >= 0) {
$wmipc->cmd(sprintf "%s %s",
$move ? "move" : "focus",
$j > $i ? "right" : "left");
} elsif ($j == @$cols && $ws->{off_right}->@*) {
with_ignored_events {
my $pushed = shift @$cols;
my $pulled = pop $ws->{off_right}->@*;
my @cmds = show_con($pulled);
push $ws->{off_left}->@*, $pushed;
if ($move) {
push @cmds, "focus left", "move right";
my $tem = pop @$cols;
push @$cols, $pulled, $tem;
} else {
$ws->{focused_col} = $pulled;
push @$cols, $pulled;
}
$wmipc->cmd(@cmds, hide_con($pushed));
};
kill USR1 => $i3status;
} elsif ($j == -1 && $ws->{off_left}->@*) {
with_ignored_events {
my $pushed = pop @$cols;
my $pulled = pop $ws->{off_left}->@*;
my @cmds = show_con($pulled);
push $ws->{off_right}->@*, $pushed;
if ($move) {
push @cmds, "focus left";
my $tem = shift @$cols;
unshift @$cols, $tem, $pulled;
} else {
push @cmds, "move left";
$ws->{focused_col} = $pulled;
unshift @$cols, $pulled;
}
$wmipc->cmd(@cmds, hide_con($pushed));
};
kill USR1 => $i3status;
}
$last_dir = $j > $i ? 1 : -1;
};
# Command dispatch
if ($cmd =~ /^(focus|move) (left|right)$/) {
$mv->($2 eq "right" ? $i+1 : $i-1, $1 eq "move");
} elsif ($cmd =~ /^cols (incr|decr)$/) {
$info{paper_ws}{$info{focused_ws}}{ncols}
+= $1 eq "incr" ? 1 : -1;
normalise_ws_cols();
kill USR1 => $i3status;
}
elsif ($cmd =~ /^other column$/) {
# This is meant to be similar to my custom Emacs C-x o.
if ($i == 0 || $last_dir == -1 && $i < $#$cols) {
$mv->($i+1);
} elsif ($i == $#$cols || $last_dir == 1) {
$mv->($i-1);
}
} elsif ($cmd eq "monocle toggle\n") {
if (my $m = $ws->{monocle}) {
undef $ws->{monocle};
normalise_ws_cols(abs ++$m);
} else {
$ws->{monocle} = -$i-1;
normalise_ws_cols();
}
kill USR1 => $i3status;
}
elsif ($cmd =~ /^fresh-workspace ?(take|send)?$/) {
fresh_workspace(do {
if ($1 && $1 eq "take") {
go => 1, send => 1;
} elsif ($1 && $1 eq "send") {
send => 1;
} else {
go => 1;
}
});
}
tied(%info)->unlock;
}
}
$pipe->reader;
open STDIN, "<&=", $pipe->fileno or die "couldn't reopen STDIN!";
# Following based on Michael Stapelberg's sample i3status-wrapper script.
my $hostname = hostname;
my $username = $ENV{LOGNAME} || $ENV{USER} || getpwuid($<);
my $hostinfo
= { name => "hostinfo", full_text => $username . "@" . $hostname };
# Skip the first line which contains the version header.
print scalar <>;
# The second line contains the start of the infinite array.
print scalar <>;
wsbuttons("no");
# Read lines forever, ignore a comma at the beginning if it exists.
while (my ($statusline) = (<> =~ /^,?(.*)/)) {
# If there is a decoding error, just skip this line, to minimise status
# bar freezes. This should be fine here because this filtering loop is in
# itself stateless. It's only if the decoding error involves newlines in
# the wrong places, or similar, that this skip could cause us to produce
# invalid output.
my $blocks = eval { decode_json $statusline } // next;
tied(%info)->lock(LOCK_SH);
if ($info{focused_ws}
&& $info{paper_ws} && keys $info{paper_ws}->%* > 1) {
my @disp;
my @keys = sorted_paper_ws();
foreach my $key (@keys) {
push @disp,
sprintf +($info{focused_ws} == $key ? "%s" : "%s"),
ws_name($info{paper_ws}{$key}{name})
}
unshift @$blocks,
{ name => "ws", markup => "pango", full_text => join " ", @disp };
}
if ($info{focused_ws} && exists $info{paper_ws}{ $info{focused_ws} }) {
sub nwin { join " ", ("\x{2021}")x$_[0] }
my $ws = $info{paper_ws}{ $info{focused_ws} };
my $left = $ws->{off_left}->@*;
my $right = $ws->{off_right}->@*;
my $disp = sprintf "%s",
$ws->{monocle} ? "\x{2020}" : nwin($ws->{ncols});
$disp = sprintf "%s %s", nwin($left), $disp if $left;
$disp = sprintf "%s %s", $disp, nwin($right) if $right;
unshift @$blocks,
{ name => "cols", markup => "pango", full_text => $disp };
}
unshift @$blocks,
{
name => "caffeinated",
full_text => "Caffeinated: " . $info{caffeinated_name} }
if $info{caffeinated_name};
tied(%info)->unlock;
unshift @$blocks, $hostinfo;
print encode_json($blocks) . ",\n";
}
sub wsbuttons {
return unless $ENV{XDG_CURRENT_DESKTOP} eq "sway";
$wmipc->cmd("bar bar-0 workspace_buttons $_[0]");
}
sub register_caffeinated {
$info{caffeinated_id} = $_[0]->{id};
$info{caffeinated_name} = $_[0]->{name};
kill USR1 => $i3status;
}
sub clear_caffeinated {
undef $info{caffeinated_id};
undef $info{caffeinated_name};
kill USR1 => $i3status;
}
sub sync_cols {
my ($node, $entry) = @_;
# Here we assume that the containers for the columns are directly below
# the type=workspace node. That won't be true if workspace_layout is not
# configured to 'default'.
foreach my $child_id ($node->{focus}->@*) {
my $child_node = first { $_->{id} == $child_id } $node->{nodes}->@*;
$entry->{focused_col} = $child_id, last
if $child_node->{type} eq "con";
}
$entry->{cols} = [];
foreach my $child_node ($node->{nodes}->@*) {
push $entry->{cols}->@*, $child_node->{id}
if $child_node->{type} eq "con";
}
}
sub normalise_ws_cols {
my $ws = $info{paper_ws}{$info{focused_ws}};
my $floating_focus;
my $old_cols = $ws->{cols};
my $old_i = shift // first { $old_cols->[$_] == $ws->{focused_col} }
0..$#$old_cols;
my @trees = $wmipc->get_tree;
while (@trees) {
for ((shift @trees)->{nodes}->@*) {
if ($_->{id} == $info{focused_ws}) {
sync_cols($_ => $ws);
my $first_focus = $_->{focus}->[0];
$floating_focus = ! grep $_ == $first_focus, $ws->{cols}->@*;
last;
}
unshift @trees, $_
}
}
my $cols = $ws->{cols};
my $i = first { $cols->[$_] eq $ws->{focused_col} } 0..$#$cols;
my @cmds;
my $avail_l = scalar $ws->{off_left}->@*;
my $avail_r = scalar $ws->{off_right}->@*;
if ($ws->{monocle} && !@$cols) {
undef $ws->{monocle};
$i = $old_i = !!$avail_l;
}
if (!$ws->{monocle} && $ws->{ncols} > @$cols && ($avail_l || $avail_r)) {
# Pull columns in if there are too few columns but some available.
# Want the focused column, after pulls, to be the $old_i'th.
my ($from_l, $from_r);
my $want = $ws->{ncols} - @$cols;
# When we lose columns, the focused column either moves left or
# stays the same. So always $old_i >= $i.
if ($old_i > $i) {
if ($old_i == $#$old_cols) {
# We were in the final column. Either we closed the
# rightmost column, or we lost arbitrary columns from the
# left (e.g. monocle from the last column).
# In either case it is fine to pull more from the left.
$from_l = min $avail_l, $want;
} else {
# We have $i < $old_i < $#$old_cols.
# We must have lost at least $old_i-$i from the left.
$from_l = min $avail_l, $old_i-$i;
}
} else { # $old_i == $i.
if ($old_i == 0) {
# We were in the first column. Either we closed the leftmost
# column, or we lost arbitrary columns from the left
# (e.g. monocle from the first column). We prefer to pull
# from the left in the former case. If we are indeed exiting
# monocle mode, we must pull from the right.
if (@$cols == 1) {
$from_r = min $avail_r, $want;
} else {
$from_l = !!$avail_l;
}
} else {
# It must be that we lost columns from the right.
$from_r = min $avail_r, $want;
}
}
if ($from_l //= min $avail_l, $want-$from_r) {
my @pulled = splice $ws->{off_left}->@*, -$from_l, $from_l;
push @cmds, ("focus left")x$i,
map +(show_con($_), "move left"), reverse @pulled;
unshift @$cols, @pulled;
$i = 0;
}
if ($from_r //= min $avail_r, $want-$from_l) {
my @pulled
= reverse splice $ws->{off_right}->@*, -$from_r, $from_r;
push @cmds, ("focus right")x($#$cols-$i),
map show_con($_), @pulled;
push @$cols, @pulled;
$i = $#$cols;
}
if ($i > $old_i) {
push @cmds, ("focus left")x($i-$old_i);
} elsif ($old_i > $i) {
push @cmds, ("focus right")x($old_i-$i);
}
$ws->{focused_col} = $cols->[$old_i];
}
# Push columns off if there are too many columns.
# This should never change which container is focused.
elsif (my $n = $ws->{monocle} ? @$cols-1 : @$cols-$ws->{ncols} > 0) {
my $left = $i;
my $right = $#$cols-$i;
if ($left >= $right) {
$left = min $left, $n;
$right = $n-$left;
} else {
$right = min $right, $n;
$left = $n-$right;
}
my @to_left = splice @$cols, 0, $left;
my @to_right = reverse splice @$cols, -$right, $right;
push @cmds, map hide_con($_), @to_left, @to_right;
push $ws->{off_left}->@*, @to_left;
push $ws->{off_right}->@*, @to_right;
}
if (@cmds) {
push @cmds, "focus floating" if $floating_focus;
with_ignored_events { $wmipc->cmd("focus tiling", @cmds) }
}
}
=head fresh_workspace(%opts)
Switch to the next free workspace, if any. Return the name of that workspace,
or undef if no workspace was available.
=cut
sub fresh_workspace {
my $next_free_workspace = compact_workspaces(leave_gap => 1);
if ($next_free_workspace) {
my @cmds;
my %opts = @_;
# Special case: if we're about to leave a workspace empty by removing
# its monocle mode container, then that workspace will get an empty
# event, and we'll lose track of any windows pushed off to the sides.
# So turn off monocle mode first.
my $ws = $info{paper_ws}{$info{focused_ws}};
if (my $m = $ws->{monocle}) {
undef $ws->{monocle};
normalise_ws_cols(abs ++$m);
}
# We need to ensure that the monitoring loop doesn't process the move
# event before it knows about the workspace change. Otherwise, that
# loop might try to unhide containers from the old workspace onto the
# new one. We do need it to process the workspace init event, else we
# don't know the ID of the new workspace without making our own query.
#
# We also want to ensure that the fresh workspace is the one that
# C-i ; will take us to. In the case that !$opts{go}, can use C-i M-j
# to move any other wanted containers over, before a final C-i ;.
#
# There is a relevant i3/Sway difference here:
# .
# (Our use of hide_con elsewhere assumes Sway's behaviour. Possibly
# we should write wrapper code that can handle either case.)
push @cmds, "workspace $next_free_workspace";
push @cmds, show_con($info{paper_ws}{$info{focused_ws}}{focused_col})
if $opts{send};
push @cmds, "workspace back_and_forth" unless $opts{go};
$wmipc->cmd(@cmds);
}
$next_free_workspace
}
=head compact_workspaces(%opts)
Rename workspaces so as to remove gaps in the sequence of workspaces.
If C<$opts{leave_gap}>, ensure there is a gap of one workspace after the
currently focused workspace and return the name of the gap workspace, or just
return undef if there is no space for a gap.
=cut
sub compact_workspaces {
my %opts = @_;
my @workspaces = sorted_paper_ws();
@workspaces < @all_workspaces or return;
my ($i, $gap_workspace, @pairs);
while (my $next = shift @workspaces) {
my $workspace = $all_workspaces[$i++];
$opts{leave_gap}
and $next == $info{focused_ws}
and $gap_workspace = $all_workspaces[$i++];
my $next_name = $info{paper_ws}{$next}{name};
next if $next_name eq $workspace;
my $pair = [$next, $workspace];
ws_num($next_name) > ws_num($workspace)
? push @pairs, $pair
: unshift @pairs, $pair
}
with_ignored_events {
$wmipc->cmd(
map sprintf("rename workspace %s to %s",
$info{paper_ws}{$_->[0]}{name}, $_->[1]),
@pairs)
};
$info{paper_ws}{$_->[0]}{name} = $_->[1] for @pairs;
$opts{leave_gap} and $gap_workspace
}
sub sorted_paper_ws {
sort { ws_num($info{paper_ws}{$a}{name})
<=> ws_num($info{paper_ws}{$b}{name}) }
keys $info{paper_ws}->%*
}
sub hide_con {
sprintf "[con_id=%s] move container to workspace %s", $_[0], "*$_[0]*"
}
sub show_con {
sprintf "[con_id=%s] move container to workspace current, focus", $_[0]
}
sub ws_name {
my ($before, $after) = split /:/, $_[0];
$after // $before
}
sub ws_num { (split /:/, $_[0])[0] }