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