bin/fvwm-convert-2.6.in

   1 #!@PERL@
   2 # -*-perl-*-
   3
   4 # Convert .fvwm2rc from 2.4.x format to 2.6.x format.
   5 #
   6 # Original author:  Thomas Adam <thomas.adam22@gmail.com> Dec. 2009
   7 #
   8 # This program is free software; you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 2 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program; if not, write to the Free Software
  20 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  21
  22 use strict;
  23 use Cwd;
  24
  25 # Global array for all our converted lines.
  26 my @converted_lines = ();
  27
  28 # Global softref for addtofunc continuations.
  29 my $last_func_ref;
  30 my %converted_funcs = ();
  31
  32 # Global for additional files...
  33 my @additional_files = ();
  34
  35 # Convert conditional command syntax correctly.
  36 sub __convert_conditionals
  37 {
  38     my( $cond ) = @_;
  39     my( $line ) = $cond->[-1];
  40
  41     $line = "$1 ". join( ', ', split( /\s+/, $2 ) ) . " $3" if $line =~
  42     /(all|current|direction|next|none|prev|pick|thiswindow|windowid)\s*(\(.*?\))(.*)/i;
  43
  44     $cond->[-1] = $line;
  45 }
  46
  47 # Process the files specified and output them to a destination file.
  48 sub process_files
  49 {
  50     my( $files ) = @_;
  51
  52     no strict "refs";
  53     foreach my $f ( @$files )
  54     {
  55         my( $s, $d ) = @$f;
  56
  57         if( (!defined $d or $d eq '') or
  58             ! -e "$s.converted" )
  59         {
  60             $d = "$s.converted";
  61         } elsif( -e $d ) {
  62             die "Destination file:  $d exists\n";
  63         }
  64
  65         open( my $in_file, '<', $s ) or die
  66             "Unable to open source file:  $!\n";
  67
  68         while( <$in_file> )
  69         {
  70             chomp;
  71             dispatch_line($_);
  72         }
  73
  74         write_out_file($d);
  75         @converted_lines = ();
  76         %converted_funcs = ();
  77     }
  78 }
  79
  80 # Convert style syntax over where applicable.
  81 sub convert_styles
  82 {
  83     my( $line ) = @_;
  84     my @converted;
  85
  86     # At the very least, we can cheat and just negate everything.  Whilst it
  87     # isn't deprecated yet, it will be -- so it won't hurt to do it here.
  88
  89     # Split the line out first of all, between the "Style foo" part, and the
  90     # actual styles being applied.
  91     my( @style_parts ) = ($line =~ /^(style\s+\"??[\w+*?]\"??)(.*)$/i);
  92
  93     # Convert the second part over.
  94     foreach( split( /\s*,\s*/, $style_parts[1] ) )
  95     {
  96         # FIXME -- this should be flagged up as bugs in FVWM.
  97         s/(?:No)(.*)/\!$1/ unless $_ =~ /nopposition/i;
  98         push @converted, $_;
  99     }
 100
 101     push @converted_lines, $style_parts[0] . join(', ',
 102         @converted);
 103 }
 104
 105 # Buckshot approach at turning fvwmthemes into colorsets.  Can't really do
 106 # much more than this, but at least gives the user something to go on.
 107 sub convert_fvwmtheme
 108 {
 109     my( $line ) = @_;
 110
 111     $line =~ s/^\*fvwmtheme\s*:?//i;
 112     $line = undef if $line =~ /modulesynchronous.*?fvwmtheme/i;
 113
 114     push @converted_lines, $line;
 115 }
 116
 117 # Comment out the modulepath line -- grr.
 118 sub handle_modulepath
 119 {
 120     my( $line ) = @_;
 121     $line = "# " . $line;
 122
 123     push( @converted_lines, $line );
 124 }
 125
 126 # This should have happened in the fvwm-2.4 convert script, but handle it
 127 # here anyway.
 128 sub convert_windowshadesteps
 129 {
 130     my( $line ) = @_;
 131     $line =~ /(\d+)p?/ ?
 132         $line = "Style * WindowShadeSteps $1" :
 133         $line = "Style * " . $line;
 134
 135     push( @converted_lines, $line );
 136 }
 137
 138 sub convert_edge_resistance
 139 {
 140     my( $line ) = @_;
 141
 142     # This gets converted into two parts.  One is the EdgeResistance
 143     # command, the other is a style line.
 144     #
 145     # We could only ever have had two numbers as arguments to
 146     # EdgeResistance.
 147     my( $edge_res_arg, $move_res_arg ) =
 148         ( $line =~ /edgeresistance\s*(\d+)\s*(\d+)/i );
 149
 150     push( @converted_lines,
 151         qq|
 152         EdgeResistance $edge_res_arg
 153         Style * EdgeMoveResistance $move_res_arg| );
 154 }
 155
 156 sub convert_snapattraction
 157 {
 158     my( $line ) = @_;
 159
 160     push( @converted_lines, "Style * " . $line );
 161 }
 162
 163 sub convert_key_mouse_bindings
 164 {
 165     my( $line ) = @_;
 166     my @components = split( /\s+/, $line, 5 );
 167
 168     # Take the last component.  We no longer care for "[*]" as conditional
 169     # command parameters.  But we shouldn't really put another conditional
 170     # in its place, so we'll just remove it.
 171     $components[-1] =~ s/\[\*\]//;
 172
 173     # Also, conditional commands should now be separated with commas and not
 174     # whitespace, so try and fix these up where we can.  It's not the
 175     # intention we'll catch them all, but at least try and do so based on
 176     # where they're likely to be used.
 177     __convert_conditionals(\@components);
 178
 179     push( @converted_lines, join ' ', @components );
 180 }
 181
 182 sub handle_continuation
 183 {
 184     no strict "refs"; # Yes, yes...
 185     my( $line ) = @_;
 186
 187     return if !defined $last_func_ref || $last_func_ref eq '';
 188
 189     eval { &{$last_func_ref}($line) };
 190
 191     warn "$@\n" if $@;
 192 }
 193
 194 sub handle_read_file
 195 {
 196     my( $line ) = @_;
 197     my @read_parts = split( /\s+/, $line );
 198     # Crudely try and work out if the file is readable, and if it is add it
 199     # to the list of further files to convert.
 200     #
 201     # This won't handle having to interpolate out any env vars set via
 202     # SetEnv, or worse yet, outside of FVWM's environment.  The user will
 203     # just have to run this script on that file manually.
 204     my $fname = $read_parts[1];
 205     return unless defined $fname and $fname ne '';
 206
 207     if( -e $fname )
 208     {
 209         push( @additional_files, [$fname] );
 210
 211         # We're done.
 212         return;
 213     }
 214
 215     # If we have this:
 216     #
 217     # Read foo
 218     #
 219     # Or this:
 220     #
 221     # Read $./foo
 222     #
 223     # Then we assume FVWM_USERDIR ("$HOME/.fvwm/"), and if that file can't
 224     # be found there, try CWD, and if that fails we just give up.
 225
 226     # Canonicalise the starting point by removing "$." -- we can guess what
 227     # it ought to be replaced with.
 228     $fname =~ s/^\$\.\/?//;
 229
 230     if( -e "$ENV{FVWM_USERDIR}/$fname" )
 231     {
 232         push( @additional_files,
 233             ["$ENV{FVWM_USERDIR}/$fname"] );
 234         return;
 235     }
 236
 237     if( -e "$ENV{HOME}/.fvwm/$fname" )
 238     {
 239         push( @additional_files,
 240             ["$ENV{HOME}/.fvwm/$fname"] );
 241         return;
 242     }
 243
 244     my $cwd_path = getcwd();
 245
 246     if( -e "$cwd_path/$fname" )
 247     {
 248         push( @additional_files, [$fname] );
 249         return;
 250     }
 251
 252     warn "Unable to follow:  $line\n";
 253 }
 254
 255 sub check_func_definition
 256 {
 257     my( $line ) = @_;
 258
 259     if( $line !~ /^addtofunc\s+(?:start|init|restart)function.*/i )
 260     {
 261         $last_func_ref = '';
 262     }
 263 }
 264
 265 sub convert_initfunc
 266 {
 267     my( $line ) = @_;
 268     $last_func_ref = "convert_initfunc";
 269
 270     if( $line =~ /addtofunc\s+initfunction\s+\"??[icmhd]{1}\"??\s+.*/i ||
 271         $line =~ /addtofunc\s+initfunction\s*/i )
 272     {
 273         $line =~ s/addtofunc\s+initfunction\s*//i;
 274     }
 275
 276     $line =~ s/^\s*\+//;
 277
 278     return if !defined $line || $line eq '';
 279
 280     # What we need to do now is convert this from:
 281     #
 282     # + I Foo
 283     #
 284     # to:
 285     #
 286     # + I Test (Init) Foo
 287
 288     my @func_cmd = split( /\s+/, $line, 3 );
 289     unshift( @func_cmd, '' ) unless @func_cmd > 2;
 290
 291     # Remove any quotes around the action type --- they're not needed
 292     # anymore.
 293     $func_cmd[1] =~ s/\"//g;
 294     $func_cmd[1] .= q| Test (Init) |;
 295
 296     # Run the command through the conditional function to ensure we
 297     # handle those correctly.
 298     __convert_conditionals( \@func_cmd );
 299
 300     push( @{ $converted_funcs{initfunction} }, join ' ', @func_cmd );
 301 }
 302
 303 sub convert_restartfunc
 304 {
 305     my( $line ) = @_;
 306     $last_func_ref = "convert_restartfunc";
 307
 308     # We treat this exactly like startfunction.
 309     if( $line =~ /addtofunc\s+restartfunction\s+\"??[icmhd]{1}\"??\s+.*/i )
 310     {
 311         # Split this string.  We can throw away the "AddToFunc" part as this
 312         # is irrelevant.  But we want the following result:
 313         # ( 'I', 'Some Command' )
 314         $line =~ s/addtofunc\s+restartfunction\s*//i;
 315     }
 316
 317     $line =~ s/addtofunc\s+restartfunction\s*//i;
 318
 319     return if $line eq '';
 320
 321     # Remove the continuation prefix as we can add this in when writing out
 322     # the function definitions later.
 323     $line =~ s/^\s*\+//;
 324
 325     my @func_cmd = split( /\s+/, $line, 2 );
 326     $func_cmd[1] =~ s/\"//g;
 327
 328     # Run the command through the conditional function to ensure we
 329     # handle those correctly.
 330     __convert_conditionals( \@func_cmd );
 331
 332     push( @{ $converted_funcs{startfunction} }, join ' ', @func_cmd );
 333 }
 334
 335 sub convert_startfunc
 336 {
 337     my( $line ) = @_;
 338
 339     # Now, it's possible that we have something like this:
 340     #
 341     # AddToFunc StartFunction I Some Command
 342     #
 343     # Extract the command part, add it to the hash for our functions, and
 344     # flag the fact we're dealing with StartFunction at this point for any
 345     # continuation lines (+ I Foo) since we can't determine the context of
 346     # them without such a thing.
 347
 348     if( $line =~ /addtofunc\s+startfunction\s+\"??[icmhd]{1}\"??\s+.*/i )
 349     {
 350         # Split this string.  We can throw away the "AddToFunc" part as this
 351         # is irrelevant.  But we want the following result:
 352         # ( 'I', 'Some Command' )
 353         $line =~ s/addtofunc\s+startfunction\s*//i;
 354     }
 355     $line =~ s/addtofunc\s+startfunction\s*//i;
 356
 357     # Remove the continuation prefix as we can add this in when writing out
 358     # the function definitions later.
 359     $line =~ s/^\s*\+//;
 360
 361     return if !defined $line || $line eq '';
 362
 363     my @func_cmd = split( /\s+/, $line, 2 );
 364     $func_cmd[1] =~ s/\"//g;
 365
 366     # Run the command through the conditional function to ensure we
 367     # handle those correctly.
 368     __convert_conditionals( \@func_cmd );
 369
 370     push( @{ $converted_funcs{startfunction} }, join ' ', @func_cmd );
 371     $last_func_ref = "convert_startfunc";
 372 }
 373
 374 sub write_out_file
 375 {
 376     my( $dest_file ) = @_;
 377     open( my $f, '>', $dest_file ) or
 378         die "Couldn't open $dest_file: $!\n";
 379
 380     # Write out most of the file.
 381     print $f join( "\n", @converted_lines );
 382
 383     # Write out the functions.
 384     print $f qq|\n\nDestroyFunc StartFunction\nAddToFunc StartFunction\n|;
 385
 386     # Put the Init stuff before anything else.
 387     for( @{ $converted_funcs{initfunction} },
 388          @{ $converted_funcs{startfunction } } )
 389     {
 390         print $f "+ $_\n";
 391     }
 392
 393     close( $f );
 394 }
 395
 396 sub dispatch_line
 397 {
 398     my( $line ) = @_;
 399
 400     if( $line =~ /^style/i )
 401     {
 402         print "Converting style lines...\n";
 403         convert_styles($line);
 404     } elsif( $line =~ /^\s*\*fvwmtheme:??/i ) {
 405         print "Converting FvwmTheme lines...\n";
 406         convert_fvwmtheme($line);
 407     } elsif( $line =~ /^\s*modulepath\s*/i ) {
 408         print "Shooting the user for ever having changed ModulePath...\n";
 409         handle_modulepath( $line );
 410     } elsif( $line =~ /^\s*windowshadesteps.*/i ) {
 411         convert_windowshadesteps($line);
 412     } elsif( $line =~ /^\s*module(?:synchronous)?.*?fvwmtheme$/i ) {
 413         convert_fvwmtheme($line);
 414     } elsif( $line =~ /^\s*edgeresistance\s*\d+\s*\d+/i ) {
 415         print "Converting EdgeResistance lines...\n";
 416         convert_edge_resistance($line);
 417     } elsif( $line =~ /^\s*key|mouse/i ) {
 418         print "Converting key/mouse bindings...\n";
 419         convert_key_mouse_bindings($line);
 420     } elsif( $line =~ /^\s*snap(?:attraction|grid)/i ) {
 421         print "Converting SnapAttraction...\n";
 422         convert_snapattraction( $line );
 423     } elsif( $line =~ /^\s*addtofunc\s+initfunction/i ) {
 424         print "Converting InitFunction...\n";
 425         convert_initfunc( $line );
 426     } elsif( $line =~ /^\s*addtofunc\s+startfunction.*/i ) {
 427         print "Converting StartFunction ...\n";
 428         convert_startfunc( $line );
 429     } elsif( $line =~ /^\s*addtofunc\s+restartfunction/i ) {
 430         print "Converting RestartFunction...\n";
 431         convert_restartfunc( $line );
 432     } elsif( $line =~ /^\s*addtofunc\s+\w+.*/i ) {
 433         check_func_definition( $line );
 434     } elsif( $line =~ /^\s*\+\s*\"??[ichmd]{1}\s*\"??\s+.*/i ) {
 435         handle_continuation( $line );
 436     } elsif( $line =~ /^\s*read\s*[\/\w]+/i ) {
 437         print "Following Read Command( $line ) ...\n";
 438         handle_read_file( $line );
 439     } else {
 440         # Could be a comment, or a continuation, or simply something we
 441         # don't need to convert.  As far as continuation lines are
 442         # concerned, these are kept in order just by pushing them onto the
 443         # array --- but converting continuation lines is tricky since we'd
 444         # need to determine the context of the continuation.  I can't be
 445         # bothered.
 446         push( @converted_lines, $_ );
 447     }
 448 }
 449
 450 sub usage
 451 {
 452     print "fvwm-convert-2.6 source-file destination-file\n";
 453     exit;
 454 }
 455
 456 usage() unless $#ARGV == 1;
 457
 458 my @files = [@ARGV];
 459 process_files( \@files );
 460 process_files( \@additional_files ) if scalar @additional_files;