#!/usr/bin/perl -w
#
# Debian install-fvwm2menu (c) Austin Donnelly 1996
#    Closely based on a sh and awk version by Lars Wirzenius.
#
# This is free software; see the GNU General Public Licence
# version 2 or later for copying conditions.  There is NO warranty.
#
# usage:
#	install-fvwm2menu --install menu entryid icon menutext cmd
#	install-fvwm2menu --remove entryid
#	install-fvwm2menu --build

$dir = $ENV{"dir"};
$HOME = $ENV{"HOME"};

$progname = `basename $0`;
chop($progname);

if (!defined($dir))
{
    if ($> == 0)
    {
	$dir = "/etc/X11/fvwm2";
    } else {
	die "$progname: can't find your home directory!\n"
	    if (!defined($HOME));
	$dir = "$HOME/.fvwm2";
    }
}

# sanity check
die "$progname: $dir doesn't exist\n" if (! -e "$dir");
die "$progname: $dir isn't a directory\n" if (! -d "$dir");

$menus_dat = "$dir/menus.dat";
$menudefs_hook = "$dir/menudefs.hook";
$main_menu_hook = "$dir/main-menu.hook";

sub usage
{
    print STDERR <<EOT ;
error: invalid arguments
usage:
    $progname --install menu entryid icon menutext cmd
        Install a new menu entry (or change an existing one)
    $progname --remove entryid
        Remove an existing menu entry
    $progname --build
        Rebuild the menu hook files after manually editing $menus_dat
EOT
    exit(1);
}

sub rebuild
{
    local (@dat, @parts, $menuname, $id, $icon, $text, $cmd,
	   %menu, %submenu, $subm, $root, %toplev, $m, $s);

    @dat=();

    open(I, "<$menus_dat")
	|| die "$progname: open $menus_dat for read: $!\n";
    open(O, ">${menudefs_hook}.new")
	|| die "$progname: open ${menudefs_hook}.new for write: $!\n";
    
    @dat = <I>;   # slurp whole file
    close(I);
    @dat = sort(@dat);

    %menu=();     # holds the text of the menu
    %submenu=();  # which submenus have been linked in yet

    foreach $line (@dat)
    {
	@parts = split(' ', $line);
	$menuname = $parts[0];
	$id = $parts[1];
	$icon = $parts[2];
	$text = $line;
	chop($text);
	$text =~ s/^[^"]*"//;
	$text =~ s/\".*//;
	$text = "%$icon%$text" if ($icon ne "none");
	$cmd = $line;
	chop($cmd);
	$cmd =~ s/^[^"]*"[^"]*" //;

	$menu{$menuname}="" if (!defined($menu{$menuname}));
	$menu{$menuname} .= "+ \"$text\" $cmd\n";

	# now create any links needed
	$root="";
  subm: foreach $subm (split(/\//, $menuname))
	{
	    $root eq "" && ($root = $subm, next subm);  # get root
	    if (!defined($submenu{"$root/$subm"}))
	    {
		$menu{$root}="" if (!defined($menu{$root}));
		$menu{$root} .= "+ \"$subm\" Popup $root/$subm\n";
		$submenu{"$root/$subm"} = 1;
	    }
	    $root .= "/$subm";
	}
    }

    # write out menu definitions
    foreach $m (keys %menu)
    {
	print O "DestroyMenu $m\n";
	$s = $m;
	$s =~ s!^.*/!!;
	print O "AddToMenu $m $s Title\n";
	print O "$menu{$m}\n";
    }
    close(O);

    rename("${menudefs_hook}.new", "$menudefs_hook")
        || die "$progname: rename(\"${menudefs_hook}.new\", \"$menudefs_hook\") failed: $!\n";

    # and the top-level entries
    open(O, ">${main_menu_hook}.new")
        || die "open ${main_menu_hook}.new for write failed: $!\n";
    %toplev=();
    foreach $line (@dat)
    {
	@parts = split(' ', $line);
	$menuname = $parts[0];
	$menuname =~ m!^([^/]+)! || die "match failed, internal error";
	$menuname = $1;
	if (!defined($toplev{$menuname}))
	{
	    $toplev{$menuname} = 1;
	    print O "+ \"$menuname\" Popup $menuname\n";
	}
    }
    close(O);

    rename("${main_menu_hook}.new", "$main_menu_hook")
        || die "$progname: rename(\"${main_menu_hook}.new\", \"$main_menu_hook\") failed: $!\n";
}


sub install
{
    local ($menu, $id, $icon, $text, $cmd) = @_;
    local ($printed);

    &touch($menus_dat);

    open(I, "<$menus_dat")
	|| die "$progname: open $menus_dat for read: $!\n";
    open(O, ">${menus_dat}.new")
	|| die "$progname: open ${menus_dat}.new for write: $!\n";

    $printed = 0;
    while(<I>)
    {
	@parts = split;
    	if ($parts[1] eq $id)
	{
	    print O "$parts[0] $id $icon \"$text\" $cmd\n";
	    $printed = 1;
	} else {
	    print O;
	}
    }
    print O "$menu $id $icon \"$text\" $cmd\n"
	if (!$printed);

    close(I);
    close(O);

    rename("${menus_dat}.new", "$menus_dat")
        || die "$progname: rename(\"${menus_dat}.new\", \"$menus_dat\") failed: $!\n";

    &rebuild;
}


sub remove
{
    local ($id) = @_;
    local (@parts);

    &touch($menus_dat);

    open(I, "<$menus_dat")
	|| die "$progname: open $menus_dat for read: $!\n";
    open(O, ">${menus_dat}.new")
	|| die "$progname: open ${menus_dat}.new for write: $!\n";

    while(<I>)
    {
	@parts = split;
	print O if ($parts[1] ne $id);
    }

    close(I);
    close(O);

    rename("${menus_dat}.new", "$menus_dat")
        || die "$progname: rename(\"${menus_dat}.new\", \"$menus_dat\") failed: $!\n";

    &rebuild;
}

sub touch
{
    local ($file) = @_;

    open(T, ">>$file") || die "$progname: touch $file: $!\n";
    close(T);
}


# Main program starts here

&usage if ($#ARGV < 0);
$opt = shift;

if ($opt eq "--install" ||
    $opt eq "-i")
{
    &usage if ($#ARGV != 4);
    &install($ARGV[0], $ARGV[1], $ARGV[2], $ARGV[3], $ARGV[4]);
    exit(0);
}

if ($opt eq "--remove" ||
    $opt eq "-r")
{
    &usage if ($#ARGV != 0);
    &remove($ARGV[0]);
    exit(0);
}

if ($opt eq "--build" ||
    $opt eq "-b")
{
    &rebuild;
    exit(0);
}

&usage;
