path: root/scripts/desktop/i3status-wrapper

#!/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 <http://www.gnu.org/licenses/>.

use 5.032;
use strict;
use warnings;
use lib "$ENV{HOME}/src/dotfiles/perl5";

use JSON;
use Local::Desktop;
use IO::Pipe;
use IPC::Shareable;
use Local::Desktop::WMIPC;
use Sys::Hostname;
use POSIX "floor", "mkfifo";
use File::Basename "basename", "dirname";
use File::Spec::Functions "catfile";
use List::Util "first", "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");
}

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.

    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}}
		  //= { 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;
	}
    }

    # Now loop forever reading events, assuming no exceptions.

    eval {
	while (my $e = <$events>) {
	    state $last_e;

	    # 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();
	    }

	    # Other container changes
	    elsif ($e->{change} && exists $info{paper_ws}{$info{focused_ws}}
		   && ($e->{change} eq "close"
		       || $e->{change} eq "focus"
		       && $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();
	    }

	    # Ticks
	    elsif ($e->{payload} && $e->{payload} eq "i3status-wrapper-ign") {
		# Ignore everything until tick telling us to unignore.
		# Thread 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}};
	    } elsif ($e->{change} && $e->{change} eq "init" && $e->{current}
		     && grep $_ eq $e->{current}{name}, @all_workspaces) {
		$info{paper_ws}{$e->{current}{id}}
		  = { off_left => [], off_right => [],
		      ncols => 2, cols => [] };
	    } elsif ($e->{change} && $e->{change} eq "empty"
		     && $e->{current}) {
		delete $info{paper_ws}{$e->{current}{id}};
	    }

	    # 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();
		}
	    }
	}
    };

    # 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>) {
	my $ws = $info{paper_ws}{$info{focused_ws}};
	my $cols = $ws->{cols};

	if ($cmd =~ /^(focus|move) (left|right)$/) {
	    my $i = first { $cols->[$_] == $ws->{focused_col} } 0..$#$cols;
	    my $move = $1 eq "move";
	    $2 eq "right" ? $i++ : $i--;
	    if (@$cols > $i >= 0) {
		$wmipc->cmd($cmd);
	    } elsif ($i == @$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 ($i == -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;
	    }
	}
    }
}

$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 <>;

# 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;

    unshift @$blocks,
      {
	  name      => "caffeinated",
	  full_text => "Caffeinated: " . $info{caffeinated_name} }
      if $info{caffeinated_name};

    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 @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};
    with_ignored_events {
	$wmipc->cmd("focus tiling");
	while (1) {
	    my $i = first { $cols->[$_] eq $ws->{focused_col} } 0..$#$cols;
	    my $mid_i = floor @$cols/2;
	    # Pull column in if there are too few columns but some available.
	    if ($ws->{ncols} > @$cols
		&& ($ws->{off_left}->@* || $ws->{off_right}->@*)) {
		if ($ws->{off_left}->@*
		    && ($i < $mid_i || !$ws->{off_right}->@*)) {
		    my $pulled = pop $ws->{off_left}->@*;
		    $wmipc->cmd(("focus left")x$i,
				show_con($pulled), "move left",
				("focus right")x$i);
		    unshift @$cols, $pulled;
		    $ws->{focused_col} = $cols->[$i];
		} elsif ($ws->{off_right}->@*
			 && ($i >= $mid_i || !$ws->{off_left}->@*)) {
		    my $j = $#$cols - $i;
		    my $pulled = pop $ws->{off_right}->@*;
		    $wmipc->cmd(("focus right")x$j,
				show_con($pulled), ("focus left")x$j);
		    push @$cols, $pulled;
		    $ws->{focused_col} = $cols->[$i+1];
		}
	    }
	    # Push a column off if there are too many columns.
	    elsif (@$cols > $ws->{ncols}) {
		my $pushed = $i < $mid_i ? pop @$cols : shift @$cols;
		$wmipc->cmd(hide_con($pushed));
		push $ws->{$i < $mid_i ? "off_right" : "off_left"}->@*,
		  $pushed;
	    }
	    # Number of columns is correct.
	    else { last }
	}
	$wmipc->cmd("focus floating") if $floating_focus;
    }
}

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]
}