######################################################################
#
#  WMAKER.PL - window maker-specific code for wmtheme
#

$tosite = 'wm.themes.org';
$badnamechars .= "'";
$preinst_callback = \&checklocaldir_wmaker;
my $wmaker_version;

  # List of allowable settings in style files

my @wmstylesettings = qw(
  ccliptitlecolor
  cliptitlecolor
  cliptitlefont
  ftitleback
  ftitlecolor
  highlightcolor
  highlighttextcolor
  iconback
  icontitleback
  icontitlecolor
  icontitlefont
  largedisplayfont
  menudisabledcolor
  menustyle
  menutextback
  menutextcolor
  menutextextendspace
  menutextfont
  menutitleback
  menutitlecolor
  menutitleextendspace
  menutitlefont
  ptitleback
  ptitlecolor
  resizebarback
  titlejustify
  utitleback
  utitlecolor
  windowtitleextendspace
  windowtitlefont
  workspacespecificback
  workspaceback

  normalcursor
  movecursor
  resizecursor
  waitcursor
  );

  # Identify Window Maker executable: check for Debian's "WindowMaker" first

$wm_executable = findexe('WindowMaker') ? 'WindowMaker' : 'wmaker';

  ###
  #
  #  WM_GETDEFAULTDIRS
  #
  ##

sub wm_getdefaultdirs {
  my $wmaker_root = $ENV{GNUSTEP_USER_ROOT} || "$home/GNUstep";

  verify_themedirs(0,
    '/usr/local/share/WindowMaker/Themes',     # DEFAULT
    '/usr/share/WindowMaker/Themes',           # Debian/Red Hat
    '/usr/X11R6/share/WindowMaker/Themes',     # Slackware
    "$wmaker_root/Library/WindowMaker/Themes"  # user
    );
}

  ###
  #
  #  WM_SCANDIR
  #
  ##

sub wm_scandir {
  my @directories = @_;
  my ($dir, $entry, %scanned, $owner);

  while ($dir = pop @directories) {
    dbugout("scanning $dir") if $debug;
    unless (opendir DH, $dir) {
      complain("can't read directory $dir: $!");
      next;
    }
    $owner = (stat $dir)[4];
    $scanned{$dir} = (stat _)[9];
    while (defined($entry = readdir DH)) {
      next if $entry =~ /^\.\.?$/;

      if (-d "$dir/$entry") {
        if ($entry =~ /(.+)\.themed$/) {
          createthemerec($1, "$dir/$entry", $owner);
        } else {
          push @directories, "$dir/$entry";
        }

      } elsif ($entry =~ /(.+)\.style$/) {
        createthemerec($1, "$dir/$entry", $owner);
      } else {
        createthemerec($entry, "$dir/$entry", $owner);
      }

    }
    closedir DH;
  }
  %scanned;
}    

  ###
  #
  #  WM_INSTALLTHEME
  #
  ###

sub wm_installtheme {
  my ($location, $filename, $defname) = @_;
  my ($themename, $dir, $destthemedir, $stylefile, $i, @files, $mvfiles);

###  Determine destination directory

  if ($> == 0) {
    if (!$globalthemedir) {
       choke("no global theme directory could be identified",
         "perhaps Window Maker is not installed on this system?");
    }
    $destthemedir = $globalthemedir;
  } else {
    checklocaldir_wmaker();
    $destthemedir = $localthemedir;
  }

###  Locate style file

  if (-d $location) {
    @files = filefind($location);
    $stylefile = teststyle_wmaker($location, @files) or
      choke("can't identify a style file; giving up");
    dbugout("Style file is $stylefile") if $debug;

    # Remove style file from list of files

    for ($i = 0; $i <= $#files; ++$i) {
      if ($files[$i] eq $stylefile) {
        splice(@files, $i, 1);
        last;
      }
    }
  } else {
    ($dir = $location) =~ s![^/]*$!!;
    if ($stylefile = teststyle_wmaker($dir, $location)) {
      dbugout("Style file is $stylefile") if $debug;
    } else {
      choke("$location does not appear to be a style file.");
    }
  }

  fixstyle_wmaker($stylefile);

###  Determine the theme's name

  if ($defname) {
    $themename = $defname;
  } else {
    if ($stylefile =~ /\/([^\/]+?)\.themed$/) {
      # a somewhat broken theme does this.. okay, we'll handle it
      $themename = $1;
    } elsif ($stylefile =~ /\/([^\/]+)\.themed\/style$/) {
      $themename = $1;
    } elsif ($stylefile =~ /\/([^\/]+)\/style$/) {
      $themename = $1;
    } elsif ($stylefile =~ /\/([^\/]+?)(?:\.style)?$/) {
      $themename = $1;
    } elsif ($stylefile =~ /\/([^\/]+)$/) {
      $themename = $1;
    } else {
      $themename = $stylefile;
    }
  }
  $themename = checkname($themename);

###  Create destination directory and move files into it

  $destthemedir .= "/$themename.themed";
  dbugout("creating destination directory $destthemedir") if $debug;

  mkdir $destthemedir, 0755 or
    choke("can't create destination directory $destthemedir: $!");
 
  $cleanups{wmaker_install} = $destthemedir;
  syscmd('mv', $stylefile, "$destthemedir/style");

   ## If $location was a single file, it had to be a style or
   ## we wouldn't have gotten this far, and the previous line
   ## would have moved it already.

  if (-d $location) {
    @files = purge_duplicates_wmaker(@files);
    syscmd('mv', @files, $destthemedir) if @files;
  }

  createthemerec($themename, $destthemedir, $>);
  delete $cleanups{wmaker_install};
  $themename;
}

  #######################################################################
  #
  #  PURGE_DUPLICATES_WMAKER
  #
  #  Removes duplicate files from a window maker theme archive,
  #  according to some wmaker-specific rules
  #
  #  This sub supports wm_installtheme
  #

sub purge_duplicates_wmaker {
  my @files = @_;
  my (%files, $filename);

  foreach (@files) {
      ###  Decide whether to keep or discard each file

    if (/\/([^\/]+$)/) {
      $filename = $1;
      if ($filename eq 'style') {
        ###  Always discard extra style files

      } elsif (!exists $files{$filename}) {
        ###  Always keep when there's no name collision
        $files{$filename} = $_;

      } elsif (/\.xvpics\//) {
        ###  Discard same-named ones in .xvpics subdirs
        ###  since they will be thumbnails and mess up the theme
        ###  if we keep them

      } elsif ($files{$filename} =~ /\.xvpics/) {
        ###  Same thing, but the earlier one was in .xvpics
        ###  so let this one replace it

        $files{$filename} = $_;
      } elsif (/\/Themes\/$filename$/) {
        ###  Keep the newer one if it's in Themes subdir

        $files{$filename} = $_;
      }
    }
  }
  values %files;
}

  #######################################################################
  #
  #  FIXSTYLE_WMAKER
  #
  #  Reads the style file, munges it, writes it back.
  #
  #  * Remove directories from pixmap paths
  #  * Remove '#' type comments
  #  * Format the whitespace
  #  * Remove unauthorized settings
  #  * Ensure *extendspace settings exist
  #
  #  This sub supports wm_installtheme
  #

sub fixstyle_wmaker {
  my $stylefile = shift;
  my $styletext = slurpfile($stylefile);
  my $wsb;  # value of setting WorkspaceSpecificBack, if present

    # touch up the whitespace

  $styletext =~ s/^\s*\{\s*(\w)/{\n  $1/s;
  $styletext =~ s/;\s*(\w+)\s*=\s*/;\n  $1 = /sg;
  $styletext =~ s/;\s*\}/;\n\}/s;

  my $pixmapsettings = join ('|', 
    'workspaceback',
    'ftitleback',
    'ptitleback',
    'utitleback',
    'resizebarback',
    'menutitleback',
    'menutextback',
    'iconback');

    #  remove all path information from pixmap settings, since the theme
    #  and its images are now in its own .themed

  $styletext =~ s/\b(($pixmapsettings)\s*=\s*\(\s*.pixmap\s*,\s*)[^",]*\//$1/sgi;
  $styletext =~ s/\b(($pixmapsettings)\s*=\s*\(\s*.pixmap\s*,\s*")[^"]*\//$1/sgi;

    #  remove an entire "WorkspaceSpecificBack" setting, leaving a token, fix
    #  its paths, and put it back:

  if ($styletext =~ s/\bworkspacespecificback\s*=\s*\(([^;]+)\)\s*;/\@WSB\@/si) {
    $wsb = $1;
    $wsb =~ s/(\(\s*.pixmap\s*,\s*)[^",]*\//$1/sgi;
    $wsb =~ s/(\(\s*.pixmap\s*,\s*")[^"]*\//$1/sgi;
    while ($styletext =~ s/\bworkspacespecificback\s*=\s*\([^;]+\)\s*;//sgi) {
      print "Warning: removing extra WorkspaceSpecificBack from style\n";
    }
    $styletext =~ s/\@WSB\@/WorkspaceSpecificBack = ($wsb);/;
  }

    #  Remove misguided comments

  $styletext =~ s/^\s*#.*$//mg;

    #  Remove settings that are related to behavior rather than to apperance
    #  (e.g. CirculateRaise)
    #  A list of allowable settings is defined, and everything else is
    #  discarded.

  read_userconfig();
  if ($config_wm{normalize_wmaker_styles} eq 'yes') {

      #  "required settings" - any of these that are not present in the style
      #  file must be added.  If you activate a theme that uses
      #  WindowTitleExtendSpace, and then activate one that does not, then
      #  ordinarily the previous theme's setting would remain, altering the
      #  appearance of the second theme.  To prevent this, these extendspace
      #  settings will be added with a value of 0 to any theme that doesn't
      #  set them.

    my %rqsettings = (
        'MenuTextExtendSpace'    => 0,
        'MenuTitleExtendSpace'   => 0,
        'WindowTitleExtendSpace' => 0,
        'WorkspaceSpecificBack'  => '()');

    my $rqmatch = lc join('|', keys %rqsettings);
    my %rqlc;

    foreach (keys %rqsettings) {
      $rqlc{lc $_} = $_;
    }

      #  OK settings are allowed, all others removed

    my $oksettings = join('|', @wmstylesettings);
    my $copystyle = $styletext;
    my $line;
    $styletext = "{\n";
    while ($copystyle =~ /\b(.+?;)/sg) {
      $line = $1;
      if ($line =~ /^(?:$oksettings)\s*=.+;/ios) {
        $styletext .= "  $line\n";
        if ($line =~ /^($rqmatch)\b/i) {
          delete $rqsettings{$rqlc{lc $1}};
        }
      } elsif ($debug) {
        dbugout("stripping setting: $line");
      }
    }
    foreach (keys %rqsettings) {
      $styletext .= "  $_ = $rqsettings{$_};\n";
      dbugout("inserting $_ = $rqsettings{$_};") if $debug;
    }

    $styletext .= "}\n";
  }

  stowfile($stylefile, $styletext);
}

  #######################################################################
  #
  #  TESTSTYLE_WMAKER
  #
  #  Examine some files and return the most likely style file.
  #
  #  This sub supports wm_installtheme
  #

sub teststyle_wmaker {
  my ($dir, @candidates) = @_;
  my ($i, $file, $filetype, $score, $settings);
  my $bestscore = 0;
  my $beststyle = '';

    ##  a) Eliminate images and certain others, and big files

  for ($i = 0; $i < @candidates;) {
    if ($candidates[$i] =~ /\.(?:gif|jpg|jpeg|png|tif|tiff|xpm|lsm)$/i
        or (stat $candidates[$i])[7] > 10240) {
      splice(@candidates, $i, 1);
    } else {
      $i++;
    }
  }

  unless ($i) {
    dbugout("failed - no candidates (1)") if $debug;
    return;
  }

  @filetypes = getfiletypes(@candidates);

    ##  b) Subject them to inhumane tests

  foreach $file (@candidates) {
    $filetype = shift @filetypes;
    $score = 0;

    #---- scoring ----#

    if ($filetype eq 'ASCII text') {
      $score += 15;
    } elsif ($filetype =~ /\btext\b/) {
      $score += 10;
    }

    $score += 10 if $file =~ m!/style$!;

    $contents = slurpfile($file);

    $score += 40 if $contents =~ /\{.*\}/s;

    $settings = 0;
    foreach (@wmstylesettings) {
      ++$settings if $contents =~ /\b$_\b/i;
    }

    $score += 40 if $settings > 5;

    #---- scoring ----#

    dbugout("($score points)  $file") if $debug;
    if ($score > $bestscore) {
      $bestscore = $score;
      $beststyle = $file;
      last if $bestscore > 89;
    }
  }

  if (!$bestscore) {
    dbugout('Failed!') if $debug;
    return undef;
  } elsif ($bestscore < 80) {
    print "$programname: warning, difficulty identifying theme's style file\n";
  } elsif ($debug) {
    dbugout("Success with $beststyle");
  }
  return $beststyle;
}

  ###
  #
  #  WM_ACTIVATETHEME
  #
  ###

sub wm_activatetheme {
  my $theme = shift;

  syscmd('setstyle', $themes{$theme}{path});
}

  ###
  #
  #  WM_UNINSTALLTHEME
  #
  ###

sub wm_uninstalltheme {
  my $theme = shift;

  dirwipe($themes{$theme}{path}, 1);
}

  ###
  #
  #  WM_RENAME
  #
  ###

sub wm_rename {
  my ($old, $new) = @_;

  my $oldpath = $themes{$old}{path};
  my $newpath = $oldpath;

  if (-d $oldpath) {
    $newpath =~ s/\/\Q$old\E\.themed$/\/$new.themed/ or
      choke("internal error: \"$oldpath\" dir doesn't end in \"$old.themed\"");
  } elsif ($newpath =~ s/\/\Q$old\E$/\/$new/) {
  } elsif ($newpath =~ s/\/\Q$old\E\.style$/\/$new.style/) {
  } else {
    choke("internal error: \"$oldpath\" doesn't end in \"$old\" or \"$old.style\"");
  }

  rename $oldpath, $newpath
    or choke("can't rename $oldpath to $newpath: $!");

  $newpath;
}

  ###
  #
  #  WM_VERSIONOK
  #
  ###

sub wm_versionok {
  my $request = shift;
  my $rqver;

  if ($request =~ /(\d*\.\d+)/) {
    $rqver = $1;
  } else {
    dbugout("Can't comprehend theme version \"$request\"!") if $debug;
    return 1;
  }

  dbugout("deciding about theme for version $rqver") if $debug;
  getversion_wmaker() or return 1;  # Just succeed if version can't be determined

  if ($rqver < 0.7) {
    return $wmaker_version < 0.7;
  } elsif ($wmaker_version < 0.7) {
    return 0;
  } elsif ($rqver < 1) {
    return $wmaker_version < 1;
  } elsif ($wmaker_version < 1) {
    return 0;
  } else {
    return 1;
  }
}

sub getversion_wmaker {

    ## The program will proceed whether the version can be determined
    ## or not.  It's very possible that root's path wouldn't include the
    ## executable.

  return $wmaker_version if defined $wmaker_version;
  $wmaker_version = '';

  $vertext = `$wm_executable --version`;
  if ($?) {
    dbugout("couldn't execute $wm_executable: $! -- version checking disabled")
      if $debug;
  } elsif ($vertext =~ /\s(\d*\.\d+)/) {
    $wmaker_version = $1;
    dbugout("Window Maker's version is $wmaker_version") if $debug;
  } else {
    dbugout("couldn't comprehend $wm_executable --version: \"$wmaker_version\" -- version checking disabled")
      if $debug;
  }
  $wmaker_version;
}

sub checklocaldir_wmaker {
  choke("There is no theme directory for this user; do you need to run wmaker.inst?")
    unless $localthemedir;
}

1;

