#############################################################################
#
#  wmtheme code for Blackbox
#

$tosite = 'bb.themes.org';
$wm_executable = 'blackbox';
$preinst_callback = \&ensurelocaldir_blackbox;

my (
  $blackboxrc,
  $mainmenu,
  %menufile,        # the menu file in which a theme is referenced.  If missing,
                    # the theme is assumed to simply be in a [stylesdir]
  %menuentry,       # menu entry in which a theme is referenced.

  %dirusage,        # how this directory's themes are referenced in the menu.
                    #  stylesdir  ==  it's in a [stylesdir]
                    #  style      ==  themes listed individually in [style]s
                    #  include:xxxxxx == themes are listed in [style]s
                    #                    in given include file
  $blackbox_version,
  $styledirs
  );


  ##
  #
  #  WM_GETDEFAULTDIRS
  #
  #  For Blackbox, this code must also scan the menu file(s) for explicitly
  #  included themes, in [style] and [include] statements.
  #
  ##

sub wm_getdefaultdirs {
  if ($>) {
    $blackboxrc = "$home/.blackboxrc";
  
    if (!-e $blackboxrc) {
      print "This looks like your first time running Blackbox.  Please restart Blackbox\n";
      print "from the root menu so I can tell what themes are available.\n";
      finish();
    }
  
    $mainmenu = readrc_blackbox();
    if (!$mainmenu) {
      print "No menu is indicated in your .blackboxrc.  Please restart Blackbox\n";
      print "from the root menu so I can tell what themes are available.\n";
      finish();
    }

    complainmenu_blackbox($mainmenu) unless -e $mainmenu;
  
    $styledirs = {};
    scanmenu_blackbox($mainmenu, $styledirs, {});
    keys %$styledirs;

  } else {

    verify_themedirs(0,
      '/usr/local/share/Blackbox/styles',   #  source tarball
      '/usr/share/blackbox/styles',         #  Debian
      '/usr/share/Blackbox/styles',         #  Red Hat   (probably)
      '/usr/X11R6/share/Blackbox/styles',   #  Slackware (probably)
      '/usr/local/share/blackbox/styles'    #  just in case
      );
  }
}

  ##
  #
  #  WM_SCANDIR
  #
  ##

sub wm_scandir {
  my $dir = shift;
  my $entry;

  opendir DH, $dir or choke("can't opendir $dir: $!");
  while (defined($entry = readdir DH)) {
    if (-f "$dir/$entry") {
      createthemerec($entry, "$dir/$entry", (stat _)[4]);
    }
  }
  return ($dir, (stat $dir)[9]);
}

  ##
  #
  #  WM_INSTALLTHEME
  #
  ##

sub wm_installtheme {
  my ($tempdir, $filename, $defname) = @_;
  my ($dest_style, $dest_bg, $rootcommand_destbg,
    @files, @filetypes, $i, $stylefile, $bgimage, $theme,
    $includedest, $specified_bg, $specified_base, @bgcandidates);

  getversion_blackbox();

   #=========================================================================
   # Determine
   #            1) style destination
   #            2) background destination
   #            3) menuitem destination, if any
   #=========================================================================

  if ($>) {
    unless (-d "$home/.blackbox") {
      mkdir "$home/.blackbox", 0755 or
        choke("can't mkdir $home/.blackbox: $!");
    }

    $dest_style = $localthemedir;

    if (-d "$home/.blackbox/backgrounds") {
      $dest_bg = "$home/.blackbox/backgrounds";
      $rootcommand_destbg = "~/.blackbox/backgrounds";
    } elsif (-d "$home/.blackbox/Backgrounds") {
      $dest_bg = "$home/.blackbox/Backgrounds";
      $rootcommand_destbg = "~/.blackbox/Backgrounds";
    } else {
      $dest_bg = "$home/.blackbox/backgrounds";
      $rootcommand_destbg = "~/.blackbox/backgrounds";
      insistdir($dest_bg);
    }
  } else {

    ## global installation as root

    ($dest_bg = $globalthemedir) =~ s!/[^/]+$!!;
    if (-d "$dest_bg/Backgrounds") {
      $dest_bg .= '/Backgrounds';
    } else {
      $dest_bg .= '/backgrounds';
      insistdir($dest_bg);
    }
    $rootcommand_destbg = $dest_bg;
    $dest_style = $globalthemedir;
  }

  dbugout("style dir is $dest_style", "bg dir is $dest_bg") if $debug;

   #=========================================================================
   # Examine files and move to destinations
   #=========================================================================

  if (-d $tempdir) {
    @files = filefind($tempdir);
  } else {
    @files = ($tempdir);
  }
    # Note: Can't depend on "file" to report that a blackbox style file is text
  @filetypes = getfiletypes(@files);
  for ($i = 0; $i < @files; ++$i) {
    if ($files[$i] =~ /\.bmp$/ or $filetypes[$i] =~ /\bimage\b/i) {
      push @bgcandidates, $files[$i];
    } elsif
      ($files[$i] =~ m!/styles/[^/]+$!i or
        (!$stylefyle and
          ($filetypes[$i] =~ /\btext\b/i or
            (stat $files[$i])[7] < 50000
          )
        )
      )
    {
      $contents = slurpfile($files[$i]);
      if ($contents =~ /^\s*\w+\.\w+.*:\s+\w+/m) {
        $stylefile = $files[$i];
      }
    }
  }

  choke('theme contains no style file') unless $stylefile;

  dbugout("style file is $stylefile") if $debug;

  if ($defname) {
    $theme = $defname;
  } else {
    ($theme = $stylefile) =~ s!.*/!!;
    ($theme = $filename) =~ s/\..*$// unless $theme;
    choke("strange, I cannot get a theme name from \"$stylefile\" or \"$filename\"")
      unless $theme;
  }
  $theme = checkname($theme);

  $bgimage = fixstyle_blackbox($stylefile, $rootcommand_destbg, @bgcandidates);
  syscmd('mv', $stylefile, "$dest_style/$theme");
  syscmd('mv', $bgimage, $dest_bg) if $bgimage;
  createthemerec($theme, "$dest_style/$theme", $>);

   #=========================================================================
   # Files are in place; insert menu item or new stylesdir
   #=========================================================================

  if (!$>) {
    if (-f "$dest_style/stylesmenu") {
      stowfile("$dest_style/stylesmenu",
        styleentry_blackbox($theme) . slurpfile("$dest_style/stylesmenu"));
    }
  } elsif (!$dirusage{$dest_style}) {

    dbugout("style goes into a _new_ [stylesdir]") if $debug;
    addtostylesmenu_blackbox("    [stylesdir] (" .
      bbmenuescape($dest_style) . ")\n");

  } elsif ($dirusage{$dest_style} =~ /^include:(.+)/) {

    $includedest = $1;
    dbugout("menu item goes into file $includedest") if $debug;

    stowfile($includedest,
      styleentry_blackbox($theme) . slurpfile($includedest));

      ## If this included fragment was empty, Blackbox won't check it
      ## and the new theme won't show up in the menu.  By touching
      ## the main menu, we cause Blackbox to scan all [include]s, even
      ## empty ones.

      ## Since [include]s that actually contain something will be
      ## checked, we won't need to touch anything when uninstalling.
    my $now = time;
    utime $now, $now, $mainmenu;

  } elsif ($dirusage{$dest_style} eq 'style') {

    addtostylesmenu_blackbox('    ' . styleentry_blackbox($theme));

  } elsif ($dirusage{$dest_style} eq 'stylesdir') {

    dbugout("style goes into an existing [stylesdir]") if $debug;

  } else {

    choke("internal error: usage of directory \"$dest_style\"",
      "is set to unknown value $dirusage{$dest_style}");

  }

  $theme;
}

sub wm_activatetheme {
  my ($themename, $explicit) = @_;
  my $rctext;

  # abort if $blackboxrc not writable

  unless (-w $blackboxrc) {
    choke("Can't activate themes: $blackboxrc isn't writable.") if $explicit;
    return;
  }

  # modify it to indicate desired theme

  $rctext = slurpfile($blackboxrc);
  if ($rctext =~ s/^(session.stylefile)\s*:.*$/$1:       $themes{$themename}{path}/mi) {
  } else {
    $rctext .= "\nsession.styleFile:      $themes{$themename}{path}\n";
  }
  stowfile($blackboxrc, $rctext);

  # send signal

  sigbyname(USR1, $wm_executable);
}

  ##
  #
  #  WM_UNINSTALLTHEME
  #
  ##

sub wm_uninstalltheme {
  my $theme = shift;
  my $bgimage;

  if (exists $menufile{$theme} and exists $menuentry{$theme}) {
    my $menutext = slurpfile($menufile{$theme});
    $menutext =~ s/\Q$menuentry{$theme}\E//s or
      choke("the theme \"$theme\" seemed to come from this menu entry:",
        "  $menuentry{$theme}",
        "in the file \"$menufile{$theme}\", but now I can't find that line!");
    stowfile($menufile{$theme}, $menutext);
    delete $menufile{$theme};
    delete $menuentry{$theme};
  }

  if ($bgimage = identifybgfile_blackbox($themes{$theme}{path})) {
    unlink expandhomedir($bgimage);
    dbugout("erased background image $bgimage") if $debug;
  }

  unlink $themes{$theme}{path};
}

  ##
  #
  #  WM_RENAME
  #
  ##

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

  my $newpath = $themes{$old}{path};
  $newpath =~ s!/[^/]+$!/$new!;

  rename $themes{$old}{path}, $newpath or
    choke("can't rename $themes{$old}{path} to $newpath:",
      " $!");

  if (exists $menufile{$old} and exists $menuentry{$old}) {
    my $menutext = slurpfile($menufile{$old});
    my $newentry = "    [style] (" .
                   bbmenuescape($new) .
                   ") {" .
                   bbmenuescape($newpath) .
                   "}\n";

    $menutext =~ s/\Q$menuentry{$old}\E/$newentry/s or
      choke("the theme \"$old\" seemed to come from this menu entry:",
        "  $menuentry{$old}",
        "in the file $menufile{$old}, but now I can't find that line in the style file");
    stowfile($menufile{$old}, $menutext);
    $menufile{$new} = $menufile{$old};
    $menuentry{$new} = $newentry;
    delete $menufile{$old};
    delete $menuentry{$old};
  }

  $newpath;
}

  ##
  #
  #  WM_VERSIONOK
  #
  ##

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

  getversion_blackbox();

  if ($blackbox_version and $request =~ /(\d+\.\d+)/) {
    $rqver = $1;
    dbugout("checking $rqver against Blackbox v$blackbox_version") if $debug;
    if ($blackbox_version < 0.6) {
      return $rqver < 0.6;
    } elsif ($blackbox_version < 0.7) {
      return $rqver >= 0.6 and $rqver < 0.7;
    } else {
      ## Make modifications here when later versions come out.
      return 1;
    }
  } else {
    dbugout("incomprehensible version \"$request\": returning ok") if $debug;
    return 1;
  }
}

  ##
  #
  #  FIXSTYLE_BLACKBOX
  #
  ##

sub fixstyle_blackbox {
  my ($stylefile, $bgdir, @bgcandidates) = @_;
  my ($line, $styletext, $rc_prefix, $imgname, $imgbase, $bgbase, $rc_postfix,
    $bgcmd, $err, $foundrootcmd, $true_bgimage, $valid_rootcommands);

  open F, $stylefile or return;
  while (defined ($line = readcontinuationline(\*F, 0))) {

    if ($foundrootcmd) {

      if ($line =~ /^\s*rootcommand\b/i) {
        print STDERR "WARNING: additional rootcommand found:\n  ${line}Disabling!\n";
        $styletext .= "# $line";
      } else {
        $styletext .= $line;
      }

    } elsif ($line =~ /^\s*rootcommand\s*:\s*(.+?)\s*$/is) {
      ($bgcmd = $1) =~ s/\\(?:\n|$)//sg;
      $bgcmd =~ s!^/\S*/!!;       # remove any path from utility
      ($rc_prefix, $rc_postfix, $imgname) = parserootcommand_blackbox($bgcmd);

      if ($imgname) {
        ($imgbase = $imgname) =~ s!.*/!!;
        if (!$imgbase) {
          complain("warning: rootCommand specifies invalid image $imgname, disabling");
          $styletext .= "#rootCommand: $bgcmd\n";
        } else {
          foreach (@bgcandidates) {
            ($bgbase = $_) =~ s!.*/!!;
            if ($bgbase and $bgbase eq $imgbase) {
              $true_bgimage = $_;
              dbugout("background image is $true_bgimage") if $debug;
              last;
            }
          }
          if (!$true_bgimage and @bgcandidates == 1) {
            $true_bgimage = $bgcandidates[0];
            complain("note: the rootCommand specified a nonexistent image ($imgbase);");
            ($imgbase = $true_bgimage) =~ s!.*/!!;
            complain("      replacing it with the only available image, $imgbase");
          }
          if ($true_bgimage) {
            $bgcmd = "$rc_prefix$bgdir/$imgbase$rc_postfix";
          } else {
            $imgname =~ m!([^/]+)$!;
            complain("warning: rootCommand specifies nonexistent image $1, disabling");
            $styletext .= "#rootCommand: $bgcmd\n";
            next;
          }
        }
      }

      if ($bgcmd =~ /^(\S+)/) {
        my $bgcommand = $1;
        read_userconfig();
        $valid_rootcommands = join('|', split(/\s+/, $config_wm{valid_rootcommands}));
        if ($bgcommand !~ /^(?:$valid_rootcommands)$/) {
          $err = "uses the unknown utility \"$bgcommand\"";
        }
        if ($bgcmd =~ /[;|`&()<>]/) {
          $err = $err ? "looks very very suspicious" : "has evil character(s)";
        }
        if ($err) {
          if ($config_wm{disable_rootcommands} eq 'yes') {
            print STDERR "Warning: this theme uses the following rootcommand:\n";
            print STDERR "  $bgcmd\n";
            print STDERR "It will be disabled because it $err.\n";
            $styletext .= "# rootCommand: $bgcmd\n";
          } else {
            print STDERR "Warning: this theme's rootcommand $err:\n";
            print STDERR "  $bgcmd\n";
            $styletext .= "rootCommand: $bgcmd\n";
          }
        } else {
          $styletext .= "rootCommand: $bgcmd\n";
          $foundrootcmd = 1;
          dbugout("rootcommand is $bgcmd") if $debug;
        }
      } else {
        print STDERR "Warning: theme has an empty rootcommand; discarding it\n";
      }

    } else {
      $styletext .= $line;
    }
  }

  close F;
  stowfile($stylefile, $styletext);
  $true_bgimage;
}

  ##
  #
  #  PARSEROOTCOMMAND_BLACKBOX
  #
  ##

sub parserootcommand_blackbox {
  my $rootcommand = shift;

  dbugout("looking at $rootcommand") if $debug;

  $rootcommand =~ s!^/\S*/!!;  # remove path from utility

  if ($rootcommand =~ /(^|^.+?\s)((?:~|\.?\.?\/).+?\/.+|\/.+)(\s.+|)$/) {
    dbugout("returning (1)  [$1] [$3] [$2]") if $debug;
    return $1, $3, $2;
  } elsif ($rootcommand =~ /(^|^.+?\s")((?:~|\.?\.?\/).+?\/.+|\/.+[^\\])("\s.+|")$/) {
    dbugout("returning (2)  [$1] [$3] [$2]") if $debug;
    return $1, $3, $2;
  }
  dbugout("didn't match.") if $debug;
  ('', '', '');
}

  ##
  #
  #  ENSURELOCALDIR_BLACKBOX
  #
  ##

sub ensurelocaldir_blackbox {
  my $rctext;

  return unless $>;
  foreach (keys %$styledirs) {
    if (((stat $_)[4] == $>) and
        (m!^\Q$home\E/.blackbox/styles$!i or !$localthemedir)) {
        $localthemedir = $_;
    }
  }
  return if $localthemedir;

  if (!-w $mainmenu) {
    print "You are currently using a global file for your Blackbox menu, which doesn't\n";
    print "say to use your local styles directory.  To install themes as this user,\n";
    print "one of two things needs to happen:\n";
    print "  a)  I can make a copy of the menu, and add a local directory for styles\n";
    print "  b)  You can edit the global menu (which is $mainmenu),\n";
    print "      and add the following line in the [submenu] (Styles) section:\n";
    print "         [stylesdir]  (~/.blackbox/styles)\n\n";
    print "Which shall it be? [choose a, b, or q to quit]: ";
    while (1) {
      my $answer = <STDIN>;
      if ($answer =~ /^[bB]/) {
        choke("Remember to restart blackbox after editing the menu.");
      } elsif ($answer =~ /^[qQ]/) {
        choke("Bye.");
      } elsif ($answer =~ /^[aA]/) {
        print "Please restart Blackbox for the new menu to take effect.\n";
        last;
      }
      print "Please enter a, b, or q: ";
    }
    makelocalmenu_blackbox();
  }

  $localthemedir = "$home/.blackbox/styles";
  syscmd('mkdir', '-p', $localthemedir);
  addtostylesmenu_blackbox("    [stylesdir] (" .
    bbmenuescape($localthemedir) . ")\n");
  setdirusage_blackbox($localthemedir, 'stylesdir', '');
}

  ##
  #
  #  MAKELOCALMENU_BLACKBOX
  #
  ##

sub makelocalmenu_blackbox {
  my $rctext;

  unless (-d "$home/.blackbox") {
    mkdir "$home/.blackbox", 0755 or
      choke("can't mkdir $home/.blackbox: $!");
  }

  copyfile($mainmenu, "$home/.blackbox/menu");
  $mainmenu = "$home/.blackbox/menu";

  $rctext = slurpfile($blackboxrc);
  unless ($rctext =~ s/^(\s*session\.menufile\s*:\s*).+$/$1$mainmenu/im) {
    choke("can't find \"session.menuFile\" in your .blackboxrc");
  }

  stowfile($blackboxrc, $rctext);
}

  ##
  #
  #  ADDTOSTYLESMENU_BLACKBOX
  #
  ##

sub addtostylesmenu_blackbox {
  my $line = shift;
  my $menutext = slurpfile($mainmenu);

  if ($menutext =~ s/(\[\s*submenu\s*\]\s*\(\s*(?:styles|themes)\s*\).+?\n)/$1$line/si) {
    stowfile($mainmenu, $menutext);
  } else {
    # fixme -- be flexible somehow (ask for name? new submenu? store in bbtheme.data?)
    complain("couldn't find a submenu called \"Styles\" or \"Themes\"!");
  }
}

  ##
  #
  #  READRC_BLACKBOX
  #
  ##

sub readrc_blackbox {
  my ($line, $menufile);

  open F, $blackboxrc or choke("can't read $blackboxrc: $!");
  while (defined($line = <F>)) {
    if ($line =~ /^\s*session\.menufile\s*:\s*(.+)\s*$/i) {
      $menufile = $1;
      last;
    }
  }
  close F;
  $menufile;
}

sub complainmenu_blackbox {
  my $menu = shift;

  complain("The menu file ($menu) indicated in ~/.blackboxrc doesn't exist.");

  if (-e '/etc/debian_version') {
    choke("Debian users should ensure that the 'menu' package is installed, then",
      "run 'update-menus'.");
  } else {
    choke("Your Blackbox kit seems to be incomplete.  It may help to remove",
      "~/.blackboxrc and restart Blackbox.");
  }
}

  ##
  #
  #  SCANMENU_BLACKBOX
  #
  ##

sub scanmenu_blackbox {
  my ($menu, $styledirs, $rccheck) = @_;
  my ($menutext, @includes, $line, $dir);

  open (F, $menu) or return;
  dbugout("reading $menu") if $debug;

  while (defined($line = <F>)) {
    next if $line =~ /^\s*#/;
    if ($line =~ /\[\s*style\s*\]\s*\((.+)\)\s*\{(.+)\}\s*$/) {
      $name = $1;
      $path = $2;
      $name =~ s/\\(.)/$1/g;
      $path =~ s/\\(.)/$1/g;
      $path = expandhomedir($path);
      ($dir = $path) =~ s!/[^/]*$!!;

      if (-f $path) {
        dbugout("adding \"$name\" from [style] entry") if $debug;
        setdirusage_blackbox($dir, 'style', '') if $menu eq $mainmenu;
        createthemerec($name, $path, (stat _)[4]);
        $menufile{$name} = $menu;
        $menuentry{$name} = $line;
        setdirusage_blackbox($dir, 'style', '');
        $$styledirs{$dir} = 1;
      } else {
        dbugout("not adding \"$name\" from invalid [style] entry")
          if $debug;
      }
    } elsif ($line =~ /\[\s*include\s*\]\s*\((.+)\)\s*$/) {
      $path = $1;
      $path =~ s/\\(.)/$1/g;
      $path = expandhomedir($path);
      ($dir = $path) =~ s!/[^/]*$!!;
      if ($$rccheck{$path}) {
        complain("warning: repeated [include] for \"$path\"");
      } elsif (-f $path) {
        dbugout("include $path") if $debug;
        setdirusage_blackbox($dir, 'include', $path) if $menu eq $mainmenu;
        push @includes, $path;
        $$rccheck{$path} = 1;
      }
    } elsif ($line =~ /\[\s*stylesdir\s*\]\s*\((.+)\)\s*$/ or
             $line =~ /\[\s*stylesmenu\s*\]\s*\(.+\)\s*\{(.+)\}\s*$/) {
        ## For our purposes, stylesdir and stylesmenu may be treated
        ## the same
      $path = $1;
      $path =~ s/\\(.)/$1/g;
      $path = expandhomedir($path);
      if ($path =~ m!^\Q$home\E/.! and ! -d $path) {
        syscmd('mkdir', '-p', $path);
        print "$programname: created directory \"$path\";\n";
        print "$programname: restart Blackbox so it will scan this directory.\n";
      }
      if (-d $path) {
        dbugout("stylesdir $path") if $debug;
        setdirusage_blackbox($path, 'stylesdir', '');
        $$styledirs{$path} = 1;
      } else {
        dbugout("not including invalid stylesdir $path")
          if $debug;
      }
    }
  }
  close F;
  foreach (@includes) {
    scanmenu_blackbox($_, $styledirs, $rccheck);
  }
}

sub setdirusage_blackbox {
  my ($dir, $usage, $include) = @_;

  if ($dirusage{$dir}) {
    if ($dirusage{$dir} ne $usage) {
      complain
        ("WARNING: The directory $dir is used as $dirusage{$dir},",
         "         but also has a [$usage] entry.");
    }
    if ($usage eq 'stylesdir') {
      $dirusage{$dir} = 'stylesdir';
    } elsif ($usage eq 'style' and $dirusage{$dir} ne 'stylesdir') {
      $dirusage{$dir} = 'style';
    }
  } elsif ($usage eq 'include') {
    $dirusage{$dir} = "include:$include";
  } else {
    $dirusage{$dir} = $usage;
  }
}

sub getversion_blackbox {
  return if defined $blackbox_version;

  if (`blackbox -version` =~ /^\S+\s+((\d+)\.(\d+))/) {
    $blackbox_version = $1;
    dbugout("version recorded as $blackbox_version") if $debug;
  } else {
    $blackbox_version = 0;
    dbugout("couldn't determine version!") if $debug;
  }
}

sub styleentry_blackbox {
  "[style] (" . bbmenuescape($_[0]) .
    ") {" . bbmenuescape($themes{$_[0]}{path}) . "}\n";
}

sub identifybgfile_blackbox {
  my $stylefile = shift;
  my $bgimage = '';
  my $line;

  open F, $stylefile or return;
  while (defined ($line = readcontinuationline(\*F, 1))) {
    if ($line =~ /^\s*rootcommand\s*:\s*(.+?)\s*$/i) {
      (undef, undef, $bgimage) = parserootcommand_blackbox($1);
      last;
    }
  }
  close F;
  $bgimage;
}

sub bbmenuescape {
  my $text = shift;
  $text =~ s/([(){}])/\\$1/g;
  $text;
}

1;

