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 );
  96
  97 sub strip_containers {
  98     my ($tree) = @_;
  99
 100     # layout is not relevant for a leaf container
 101     delete $tree->{layout} if leaf_node($tree);
 102
 103     # fullscreen_mode conveys no state at all, it can either be 0 or 1 and the
 104     # default is _always_ 0, so skip noop entries.
 105     delete $tree->{fullscreen_mode} if $tree->{fullscreen_mode} == 0;
 106
 107     # names for non-leafs are auto-generated and useful only for i3 debugging
 108     delete $tree->{name} unless leaf_node($tree);
 109
 110     delete $tree->{geometry} if zero_rect($tree->{geometry});
 111
 112     delete $tree->{current_border_width} if $tree->{current_border_width} == -1;
 113
 114     for my $key (keys %$tree) {
 115         next if exists($allowed_keys{$key});
 116
 117         delete $tree->{$key};
 118     }
 119
 120     for my $key (qw(nodes floating_nodes)) {
 121         $tree->{$key} = [ map { strip_containers($_) } @{$tree->{$key}} ];
 122     }
 123
 124     return $tree;
 125 }
 126
 127 my $json_xs = JSON::XS->new->pretty(1)->allow_nonref->space_before(0)->canonical(1);
 128
 129 sub zero_rect {
 130     my ($rect) = @_;
 131     return $rect->{x} == 0 &&
 132            $rect->{y} == 0 &&
 133            $rect->{width} == 0 &&
 134            $rect->{height} == 0;
 135 }
 136
 137 # Dumps the containers in JSON, but with comments to explain the user what she
 138 # needs to fix.
 139 sub dump_containers {
 140     my ($tree, $ws, $last) = @_;
 141
 142     $ws //= "";
 143
 144     say $ws . '{';
 145
 146     $ws .= (' ' x 4);
 147
 148     if (!leaf_node($tree)) {
 149         my $desc = $tree->{layout} . ' split container';
 150         if ($tree->{type} ne 'con') {
 151             $desc = $tree->{type};
 152         }
 153         say "$ws// $desc with " . @{$tree->{nodes}} . " children";
 154     }
 155
 156     # Turn “window_properties” into “swallows” expressions, but only for leaf
 157     # nodes. It only makes sense for leaf nodes to swallow anything.
 158     if (leaf_node($tree)) {
 159         my $swallows = {};
 160         for my $property (keys %{$tree->{window_properties}}) {
 161             $swallows->{$property} = '^' . quotemeta($tree->{window_properties}->{$property}) . '$';
 162         }
 163         $tree->{swallows} = [ $swallows ];
 164     }
 165     delete $tree->{window_properties};
 166
 167     my @keys = sort keys %$tree;
 168     for (0 .. (@keys-1)) {
 169         my $key = $keys[$_];
 170         # Those are handled recursively, not printed.
 171         next if $key eq 'nodes' || $key eq 'floating_nodes';
 172
 173         # JSON::XS’s encode appends a newline
 174         chomp(my $val = $json_xs->encode($tree->{$key}));
 175
 176         # Fix indentation. Keep in mind we are producing output to be
 177         # read/modified by a human.
 178         $val =~ s/^/$ws/mg;
 179         $val =~ s/^\s+//;
 180
 181         # Comment out all swallows criteria, they are just suggestions.
 182         if ($key eq 'swallows') {
 183             $val =~ s,^(\s*)\s{3}",\1// ",gm;
 184         }
 185
 186         # Append a comma unless this is the last value.
 187         # Ugly, but necessary so that we can print all values before recursing.
 188         my $comma = ($_ == (@keys-1) &&
 189                      @{$tree->{nodes}} == 0 &&
 190                      @{$tree->{floating_nodes}} == 0 ? '' : ',');
 191         say qq#$ws"$key": $val$comma#;
 192     }
 193
 194     for my $key (qw(nodes floating_nodes)) {
 195         my $num = scalar @{$tree->{$key}};
 196         next if !$num;
 197
 198         say qq#$ws"$key": [#;
 199         for (0 .. ($num-1)) {
 200             dump_containers(
 201                 $tree->{$key}->[$_],
 202                 $ws . (' ' x 4),
 203                 ($_ == ($num-1)));
 204         }
 205         say qq#$ws]#;
 206     }
 207
 208     $ws =~ s/\s{4}$//;
 209
 210     say $ws . ($last ? '}' : '},');
 211 }
 212
 213 my $tree = $i3->get_tree->recv;
 214
 215 my $dump;
 216 if (defined($workspace)) {
 217     $dump = filter_containers($tree, sub {
 218         $_->{type} eq 'workspace' && $_->{name} eq $workspace
 219     });
 220 } else {
 221     $dump = filter_containers($tree, sub {
 222         $_->{type} eq 'output' && $_->{name} eq $output
 223     });
 224     # Get the output’s content container (living beneath dockarea containers).
 225     $dump = first { $_->{type} eq 'con' } @{$dump->{nodes}};
 226 }
 227
 228 $dump = strip_containers($dump);
 229
 230 say "// vim:ts=4:sw=4:et";
 231 for my $key (qw(nodes floating_nodes)) {
 232     for (0 .. (@{$dump->{$key}} - 1)) {
 233         dump_containers($dump->{$key}->[$_], undef, 1);
 234         # Newlines separate containers so that one can use { and } in vim to
 235         # jump out of the current container.
 236         say '';
 237     }
 238 }
 239
 240 =encoding utf-8
 241
 242 =head1 NAME
 243
 244     i3-save-tree - save (parts of) the layout tree for restoring
 245
 246 =head1 SYNOPSIS
 247
 248     i3-save-tree [--workspace=name] [--output=name]
 249
 250 =head1 DESCRIPTION
 251
 252 Dumps a workspace (or an entire output) to stdout. The data is supposed to be
 253 edited a bit by a human, then later fed to i3 via the append_layout command.
 254
 255 The append_layout command will create placeholder windows, arranged in the
 256 layout the input file specifies. Each container should have a swallows
 257 specification. When a window is mapped (made visible on the screen) that
 258 matches the specification, i3 will put it into that place and kill the
 259 placeholder.
 260
 261 =head1 OPTIONS
 262
 263 =over
 264
 265 =item B<--workspace=name>
 266
 267 Specifies the workspace that should be dumped, e.g. 1. Either this or --output
 268 need to be specified.
 269
 270 =item B<--output=name>
 271
 272 Specifies the output that should be dumped, e.g. LVDS-1. Either this or
 273 --workspace need to be specified.
 274
 275 =back
 276
 277 =head1 VERSION
 278
 279 Version 0.1
 280
 281 =head1 AUTHOR
 282
 283 Michael Stapelberg, C<< <michael at i3wm.org> >>
 284
 285 =head1 LICENSE AND COPYRIGHT
 286
 287 Copyright 2013 Michael Stapelberg.
 288
 289 This program is free software; you can redistribute it and/or modify it
 290 under the terms of the BSD license.
 291
 292 =cut