git.sur5r.net Git - i3/i3/blob - i3-save-tree

   1 #!/usr/bin/env perl
   2 # vim:ts=4:sw=4:expandtab
   3 #
   4 # © 2013-2014 Michael Stapelberg
   5 #
   6 # Requires perl ≥ v5.10, AnyEvent::I3 and JSON::XS
   7
   8 use strict;
   9 use warnings qw(FATAL utf8);
  10 use Data::Dumper;
  11 use IPC::Open2;
  12 use POSIX qw(locale_h);
  13 use File::Find;
  14 use File::Basename qw(basename);
  15 use File::Temp qw(tempfile);
  16 use Getopt::Long;
  17 use Pod::Usage;
  18 use AnyEvent::I3;
  19 use JSON::XS;
  20 use List::Util qw(first);
  21 use Encode qw(decode);
  22 use v5.10;
  23 use utf8;
  24 use open ':encoding(UTF-8)';
  25
  26 binmode STDOUT, ':utf8';
  27 binmode STDERR, ':utf8';
  28
  29 my $workspace;
  30 my $output;
  31 my $result = GetOptions(
  32     'workspace=s' => \$workspace,
  33     'output=s' => \$output,
  34     'version' => sub {
  35         say "i3-save-tree 0.1 © 2013 Michael Stapelberg";
  36         exit 0;
  37     },
  38     'help' => sub {
  39         pod2usage(-exitval => 0);
  40     });
  41
  42 die "Could not parse command line options" unless $result;
  43
  44 if (!defined($workspace) && !defined($output)) {
  45     die "One of --workspace or --output need to be specified";
  46 }
  47
  48 unless (defined($workspace) ^ defined($output)) {
  49     die "Only one of --workspace or --output can be specified";
  50 }
  51
  52 $workspace = decode('utf-8', $workspace);
  53 $output = decode('utf-8', $output);
  54
  55 my $i3 = i3();
  56 if (!$i3->connect->recv) {
  57     die "Could not connect to i3";
  58 }
  59
  60 sub filter_containers {
  61     my ($tree, $pred) = @_;
  62
  63     $_ = $tree;
  64     return $tree if $pred->();
  65
  66     for my $child (@{$tree->{nodes}}, @{$tree->{floating_nodes}}) {
  67         my $result = filter_containers($child, $pred);
  68         return $result if defined($result);
  69     }
  70
  71     return undef;
  72 }
  73
  74 sub leaf_node {
  75     my ($tree) = @_;
  76
  77     return $tree->{type} eq 'con' &&
  78            @{$tree->{nodes}} == 0 &&
  79            @{$tree->{floating_nodes}} == 0;
  80 }
  81
  82 my %allowed_keys = map { ($_, 1) } qw(
  83     type
  84     fullscreen_mode
  85     layout
  86     border
  87     current_border_width
  88     floating
  89     percent
  90     nodes
  91     floating_nodes
  92     name
  93     geometry
  94     window_properties
  95     mark
  96 );
  97
  98 sub strip_containers {
  99     my ($tree) = @_;
 100
 101     # layout is not relevant for a leaf container
 102     delete $tree->{layout} if leaf_node($tree);
 103
 104     # fullscreen_mode conveys no state at all, it can either be 0 or 1 and the
 105     # default is _always_ 0, so skip noop entries.
 106     delete $tree->{fullscreen_mode} if $tree->{fullscreen_mode} == 0;
 107
 108     # names for non-leafs are auto-generated and useful only for i3 debugging
 109     delete $tree->{name} unless leaf_node($tree);
 110
 111     delete $tree->{geometry} if zero_rect($tree->{geometry});
 112
 113     delete $tree->{current_border_width} if $tree->{current_border_width} == -1;
 114
 115     for my $key (keys %$tree) {
 116         next if exists($allowed_keys{$key});
 117
 118         delete $tree->{$key};
 119     }
 120
 121     for my $key (qw(nodes floating_nodes)) {
 122         $tree->{$key} = [ map { strip_containers($_) } @{$tree->{$key}} ];
 123     }
 124
 125     return $tree;
 126 }
 127
 128 my $json_xs = JSON::XS->new->pretty(1)->allow_nonref->space_before(0)->canonical(1);
 129
 130 sub zero_rect {
 131     my ($rect) = @_;
 132     return $rect->{x} == 0 &&
 133            $rect->{y} == 0 &&
 134            $rect->{width} == 0 &&
 135            $rect->{height} == 0;
 136 }
 137
 138 # Dumps the containers in JSON, but with comments to explain the user what she
 139 # needs to fix.
 140 sub dump_containers {
 141     my ($tree, $ws, $last) = @_;
 142
 143     $ws //= "";
 144
 145     say $ws . '{';
 146
 147     $ws .= (' ' x 4);
 148
 149     if (!leaf_node($tree)) {
 150         my $desc = $tree->{layout} . ' split container';
 151         if ($tree->{type} ne 'con') {
 152             $desc = $tree->{type};
 153         }
 154         say "$ws// $desc with " . @{$tree->{nodes}} . " children";
 155     }
 156
 157     # Turn “window_properties” into “swallows” expressions, but only for leaf
 158     # nodes. It only makes sense for leaf nodes to swallow anything.
 159     if (leaf_node($tree)) {
 160         my $swallows = {};
 161         for my $property (keys %{$tree->{window_properties}}) {
 162             $swallows->{$property} = '^' . quotemeta($tree->{window_properties}->{$property}) . '$';
 163         }
 164         $tree->{swallows} = [ $swallows ];
 165     }
 166     delete $tree->{window_properties};
 167
 168     my @keys = sort keys %$tree;
 169     for (0 .. (@keys-1)) {
 170         my $key = $keys[$_];
 171         # Those are handled recursively, not printed.
 172         next if $key eq 'nodes' || $key eq 'floating_nodes';
 173
 174         # JSON::XS’s encode appends a newline
 175         chomp(my $val = $json_xs->encode($tree->{$key}));
 176
 177         # Fix indentation. Keep in mind we are producing output to be
 178         # read/modified by a human.
 179         $val =~ s/^/$ws/mg;
 180         $val =~ s/^\s+//;
 181
 182         # Comment out all swallows criteria, they are just suggestions.
 183         if ($key eq 'swallows') {
 184             $val =~ s,^(\s*)\s{3}",\1// ",gm;
 185         }
 186
 187         # Append a comma unless this is the last value.
 188         # Ugly, but necessary so that we can print all values before recursing.
 189         my $comma = ($_ == (@keys-1) &&
 190                      @{$tree->{nodes}} == 0 &&
 191                      @{$tree->{floating_nodes}} == 0 ? '' : ',');
 192         say qq#$ws"$key": $val$comma#;
 193     }
 194
 195     for my $key (qw(nodes floating_nodes)) {
 196         my $num = scalar @{$tree->{$key}};
 197         next if !$num;
 198
 199         say qq#$ws"$key": [#;
 200         for (0 .. ($num-1)) {
 201             dump_containers(
 202                 $tree->{$key}->[$_],
 203                 $ws . (' ' x 4),
 204                 ($_ == ($num-1)));
 205         }
 206         say qq#$ws]#;
 207     }
 208
 209     $ws =~ s/\s{4}$//;
 210
 211     say $ws . ($last ? '}' : '},');
 212 }
 213
 214 my $tree = $i3->get_tree->recv;
 215
 216 my $dump;
 217 if (defined($workspace)) {
 218     $dump = filter_containers($tree, sub {
 219         $_->{type} eq 'workspace' && $_->{name} eq $workspace
 220     });
 221 } else {
 222     $dump = filter_containers($tree, sub {
 223         $_->{type} eq 'output' && $_->{name} eq $output
 224     });
 225     # Get the output’s content container (living beneath dockarea containers).
 226     $dump = first { $_->{type} eq 'con' } @{$dump->{nodes}};
 227 }
 228
 229 $dump = strip_containers($dump);
 230
 231 say "// vim:ts=4:sw=4:et";
 232 for my $key (qw(nodes floating_nodes)) {
 233     for (0 .. (@{$dump->{$key}} - 1)) {
 234         dump_containers($dump->{$key}->[$_], undef, 1);
 235         # Newlines separate containers so that one can use { and } in vim to
 236         # jump out of the current container.
 237         say '';
 238     }
 239 }
 240
 241 =encoding utf-8
 242
 243 =head1 NAME
 244
 245     i3-save-tree - save (parts of) the layout tree for restoring
 246
 247 =head1 SYNOPSIS
 248
 249     i3-save-tree [--workspace=name] [--output=name]
 250
 251 =head1 DESCRIPTION
 252
 253 Dumps a workspace (or an entire output) to stdout. The data is supposed to be
 254 edited a bit by a human, then later fed to i3 via the append_layout command.
 255
 256 The append_layout command will create placeholder windows, arranged in the
 257 layout the input file specifies. Each container should have a swallows
 258 specification. When a window is mapped (made visible on the screen) that
 259 matches the specification, i3 will put it into that place and kill the
 260 placeholder.
 261
 262 =head1 OPTIONS
 263
 264 =over
 265
 266 =item B<--workspace=name>
 267
 268 Specifies the workspace that should be dumped, e.g. 1. Either this or --output
 269 need to be specified.
 270
 271 =item B<--output=name>
 272
 273 Specifies the output that should be dumped, e.g. LVDS-1. Either this or
 274 --workspace need to be specified.
 275
 276 =back
 277
 278 =head1 VERSION
 279
 280 Version 0.1
 281
 282 =head1 AUTHOR
 283
 284 Michael Stapelberg, C<< <michael at i3wm.org> >>
 285
 286 =head1 LICENSE AND COPYRIGHT
 287
 288 Copyright 2013 Michael Stapelberg.
 289
 290 This program is free software; you can redistribute it and/or modify it
 291 under the terms of the BSD license.
 292
 293 =cut