fvwm 1:2.6.5.ds-4.1 / usr / bin / fvwm-convert-2.4

#!/usr/bin/perl
# -*-perl-*-

# Convert .fvwm2rc from 2.2.x format to 2.4.x format.

# Originally written by Dan Espen <despen@telcordia.com> Sept 2000

# 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 2 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, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

($source,$dest) = @ARGV;
if ( $source eq "") {
  $source = "$ENV{'HOME'}/.fvwm2rc";
}
if ( ! -e $source ) {
  die "Can't find source file $source, giving up.\n";
}

if ($dest eq "") {
  $dest = "$ENV{'HOME'}/.fvwm/.fvwm2rc";
}
$dest2 = "$dest.pass1";
if ( -e $dest ) {
  die "Output file $dest already exists, exiting.\n";
}
if ( -e $dest2 ) {
  die "Output file $dest2 already exists, exiting.\n";
}
system "cp -p $source $dest 2>/dev/null"; # try to preserve permissions
system "cp -p $source $dest2 2>/dev/null"; # try to preserve permissions

$[ = 1;				# set array base to 1
$, = ' ';			# set output field separator
$\ = "\n";			# set output record separator

# GlobalOpts that became Styles:
%OPTS = ('SMARTPLACEMENTISREALLYSMART','MinOverlapPlacement',
	 'SMARTPLACEMENTISNORMAL','TileCascadePlacement',
	 'ACTIVEPLACEMENTHONORSSTARTSONPAGE',
	   'ManualPlacementHonorsStartsOnPage',
	 'ACTIVEPLACEMENTIGNORESSTARTSONPAGE',
	   'ManualPlacementIgnoresStartsOnPage',
	 'CLICKTOFOCUSDOESNTPASSCLICK', 'ClickToFocusPassesClickOff',
	 'CLICKTOFOCUSDOESNTRAISE', 'ClickToFocusRaisesOff',
	 'MOUSEFOCUSCLICKDOESNTRAISE', 'MouseFocusClickRaisesOff',
	 'NOSTIPLEDTITLES', 'StippledTitleOff',
	 'STIPLEDTITLES', 'StippledTitle');

# GlobalOpts that became BugOpts:
%BUGOPTS= ('RAISEOVERNATIVEWINDOWS','RaiseOverNativeWindows on',
	   'IGNORENATIVEWINDOWS','RaiseOverNativeWindows off');

print "Input from $source, output to $dest\n";
parse_pass($source, $dest2, 1);
parse_pass($dest2, $dest, 2);
unlink($dest2);
exit 0;


sub parse_pass {
  local($sourcefile, $destfile, $pass) = @_;

  open(IN, $sourcefile) || die "Can't open $source";
  open(STDOUT, ">$destfile") || die "Can't redirect stdout to $dest2";
  if ($pass == 2) {
    print '# This file changed by the .fvwm2rc to .fvwm/.fvwm2rc converter';
  }
  # create assoc array by imagepath:
  $imagepath = '/usr/include/X11/bitmaps:/usr/include/X11/pixmaps';
  $isize = (@iarray = split(/:/, $imagepath, 9999));
  for ($i = 1; $i <= $isize; ++$i) {
    $iassoc{$iarray[$i]} = '1';
  }

  $newwarn = "";
  $commchar="#";			# help un-confuse emacs.
 line: while ( <IN> ) {
    chomp;			# strip record separator
    @Fld = split(' ', $_, 9999);
    if (/^\s*[$commchar]/) {	# Comment, pass it thru
      print $_;
      $line = $_;
      while (substr($line, length($line), 1) eq "\\") { # backslashed lines
	$line = &Getline1();
	print $line;
      }
      next line;
    }

    if (/^\s*$/) {		# Empty line, pass it thru
      print $_;
      next line;
    }

    $lastwarn = $newwarn;
    $newwarn = "";

    # Adds "path" to "newpath":
    if (/^\s*ICONPATH|^\s*PIXMAPPATH/i) { # Fix up IconPath/PixmapPath:
      $newpath = '';
      &add_to_path($Fld[2]);
      $line = $_;
      # prime possible loop
      while (substr($line, length($line), 1) eq "\\") {
	$line = &Getline1();
	&add_to_path($line);
      }
      if ($newpath eq '') {
	print
	  '# To use your own icons, uncomment and change the next line';
	print "#ImagePath \$HOME/icons:+";
      }
      else {
	print 'ImagePath ' . $newpath . ':+';
      }
      next line;
    }

    # Change GlobOpts to "Style * xxx, ..." commands
    if (/^\s*globalopts/i) { # Fix up GlobalOpts:
      $newopts = '';
      @rest=@Fld;			# copy the whole line
      shift @rest;		# remove first element
      &add_to_opts(join($",@rest)); # pass rest of line
      $line = $_;			# prime possible loop
      while (substr($line, length($line), 1) eq "\\") { # backslashed lines
	$line = &Getline1();
	&add_to_opts($line);	# build up newopts
      }
      if ($newopts eq '') {
	next line;		# GlobalOpts without argument, drop silently
      }
      else {
	print 'Style "*"  ' . $newopts;	# print as style command
      }
      next line;
    }

    if (/^\s*MODULEPATH/i) {
      # Deletes continuation lines too, although if there are
      # continuation lines, there might be some part of the path we want to
      # Delete them anyway.
      print '# Removed by fvwm-convert-2.4: ' . $_;
      while (substr($_, length($_), 1) eq "\\") {
	$_ = &Getline1();
	print '# Removed by fvwm-convert-2.4: ' . $_;
      }
      next line;
    }

    $single_lines = $_;
    if ($pass == 2) {
      $line = $_;
      # collect continuation lines
      while (substr($line, length($line), 1) eq "\\") { # backslashed lines
	$old_line = substr($line, 1, length($line) - 1);
	$new_line = &Getline1();
	$single_lines = "$single_lines\n$new_line";
	$line = "$old_line$new_line";
      }
      $_ = $line;
    }

    if (/^\s*HILIGHTCOLOR\s/i) {
      @colors = split("/", $Fld[2], 9999);
      if ($colors[2] eq '') {
	$colors[1] = $Fld[2];
	$colors[2] = $Fld[3];
      }
      print "Style \"*\" HilightFore " . $colors[1] . ', HilightBack ' .
	$colors[2];
      next line;
    }

    if (/^\s*HILIGHTCOLORSET/i) {
      print "Style \"*\" HilightColorset " . $Fld[2];
      next line;
    }

    if (/^\s*WINDOWSHADEANIMATE/i) {
      print "Style \"*\" WindowShadeSteps " . $Fld[2];
      next line;
    }

    if (/^\s*WINDOWFONT/i) {
      print "Style \"*\" Font " . $Fld[2];
      next line;
    }

    if (/^\s*ICONFONT/i) {
      print "Style \"*\" IconFont " . $Fld[2];
      next line;
    }

    if (/^\s*COLORLIMIT/i) {
      print '# Removed by fvwm-convert-2.4: ' . $_;
      next line;
    }

    # generate warnings in pass 2 only
    if ($pass == 2) {
      if (/^\s*[*].+PANEL/i) {
	if ($lastwarn ne "panel") {
	  print STDERR "Possible old style FvwmButtons Panel definition found";
	  print STDERR
	    "  See FvwmButtons(1), \"CONVERTING OLD PANEL CONFIGURATIONS\"";
	}
	print STDERR "  $_";
	print $_;
	$newwarn = "panel";
	next line;
      }

      if (/^\s*READ/i) {
	if ($lastwarn ne "read") {
	  print STDERR
	    "Read command found, file(s) must be converted in a separate run:";
	}
	print STDERR "  $_";
	print $_;
	$newwarn = "read";
	next line;
      }

      if (/FvwmConfig/i) {
	print STDERR "The FvwmConfig module is no longer part of fvwm:";
	print STDERR "  $_";
	if (/^\s*[*]?\s*FvwmConfig/i) {
	  print STDERR "  Line commented out.";
	  print '# Removed by fvwm-convert-2.4: ' . $_;
	  next line;
	}
	else {
	  print $_;
	}
	next line;
      }

      if (/FvwmPipe/i) {
	print STDERR "The FvwmPipe module is no longer part of fvwm:";
	print STDERR "  $_";
	if (/^\s*[*]?\s*FvwmPipe/i) {
	  print STDERR "  Line commented out.";
	  print '# Removed by fvwm-convert-2.4: ' . $_;
	}
	else {
	  print $_;
	}
	next line;
      }
      if (/RANDOMPLACEMENT|ACTIVEPLACEMENT|SMARTPLACEMENT/i ||
	  /DUMBPLACEMENT|CLEVERPLACEMENT/i) {
	$newwarn = "placement";
	if ($lastwarn ne $newwarn) {
	  print STDERR
	    "Placement style names can not be converted automatically:";
	  print STDERR
	    "  See fvwm(1), \"Window manager placement\" for instructions.";
	}
	print STDERR "  $_";
	print $_;
	$newwarn = "placement";
	next line;
      }
    }
    $lastwarn = "";
    print $single_lines;			# pass everything else thru
  }
  close(IN);
  close(STDOUT);
}











sub add_to_path {
  local($path) = @_;
  $psize = (@parray = split(/:/, $path, 9999));
  # split them up
  for ($i = 1; $i <= $psize; ++$i) {
    # Drop any builtin imagepath:
    if ($iassoc{$parray[$i]} eq '1') {
      next;
    }
    if ($parray[$i] eq "\\") {
      next;
    }

    # Maybe this next line should only skip files starting with $,
    # that dont start with  $HOME.
    if (substr($parray[$i], 1, 1) eq "\$") {
      next;
    }

    if ($newpath eq '') {
      $newpath = $parray[$i];
    }
    else {
      $newpath = $newpath . ':' . $parray[$i];
    }
  }
}

# take one GlobalOpt and convert it to a style argument -or-
# just print any bugOpts
sub add_to_opts {
  local($opts) = @_;
  $psize = (@parray = split(/[ ,\t]/, $opts, 9999));
  # split them up
  for ($i = 1; $i <= $psize; ++$i) {
    if ($parray[$i] eq "\\") {
      next;
    }
    if ($parray[$i] eq "") {
      next;
    }

    # Convert args:
    # Some args are the same in a style command
    # Some are changed a little,
    # the native window stuff becomes a BugOpt

    $work = $parray[$i];	# init w. unconverted arg
    $uwork = uc $work;		# uppercase version for lookup
    $newStyleArg = $OPTS{$uwork}; # do conversion using hash
    if ($newStyleArg ne '') {	# if arg got converted
      $work = $newStyleArg;	# save new arg
    }

    $bugArg = $BUGOPTS{$uwork};	# convert using hash
    if ($bugArg ne '') {	# if converted
      print 'BugOpts ' . $bugArg;
    } else {			# if not bugOpt, accum
      if ($newopts eq '') {	# first time, just arg
	$newopts = $work;
      } else {
	$newopts = $newopts . ', ' . $work; # add comma and arg
      }
    }				# end bugArg vs. style
  }				# end for
}

sub Getline1 {
  local($_);
  if ($getline_ok = (($_ = <IN>) ne '')) {
    chomp;			# strip record separator
  }
  $_;
}