#!/usr/bin/perl -w
#$Id: vfmg,v 1.90 2006/04/19 00:02:33 sparky Exp $

use strict;
use File::Find qw(find);
use Getopt::Long qw(GetOptions :config bundling);
use Encode qw(encode decode);

my $VERSION = "0.9.95";

# header {{{
# default options {{{
my $o_help=0;
my $o_version=0;
my $o_tags=0;
my $o_end=0;
my $o_verbose=0;
my %defopt = (
	exec		=> 0,
	exec_full	=> 0,
	icons		=> 1,
	icons_ext	=> 0,
	icons_full	=> 0,
	icons_scale	=> 0,
	icons_fork	=> 0,
	icons_dir	=> "",
	icons_oext	=> "png",
	
	utf			=> 0,
	encoding	=> "",
	
	clear		=> 0,
	promote		=> 0,
	strip		=> 0,
	nomenu		=> 0,
	only_in		=> "",
	xterm		=> "xterm -name xterm-%1 -e %2",
	convert		=> "convert -geometry 16x16 \%in \%out",
	full_regen	=> 0,
	destdir		=> "",
	
);
my %opt;
my $o_output;
$defopt{xterm}="$ENV{'VFMG_TERM'}" if $ENV{'VFMG_TERM'};

my @wms = qw(ASCII DR17 aewm afterstep blackbox enlightenment fbpanel fluxbox
	fvwm fvwm2 icewm metisse olvwm openbox qvwm wmaker wmaker-old wmii xfce4
	xpde);

# %destdir and %iconsdir should only contain directories propsed by WM
my %destdir = (
	DR17			=>	"$ENV{'HOME'}/.e/e/applications/favorite",
	afterstep		=>	"$ENV{'HOME'}/GNUstep/Library/AfterStep/start",
	enlightenment	=>	"$ENV{'HOME'}/.enlightenment/menus",
	xpde			=>	"$ENV{'HOME'}/.xpde/Start Menu/Programs",
);
my %iconsdir = (
	DR17			=>	"$ENV{'HOME'}/.e/e/applications/all",
	enlightenment	=>	"$ENV{'HOME'}/.enlightenment/icons",
);
# }}}

GetOptions( # {{{
	'help|h'		=>	\$o_help,
	'version|V'		=>	\$o_version,
	'tags|t'		=>	\$o_tags,
	'end|e'			=>	\$o_end,
	'verbose|v'		=>	\$o_verbose,
	
	'exec|x!'		=>	\$opt{exec},
	'exec-full|full-exec|X!'
					=>	\$opt{exec_full},
	'icons|i!'		=>	\$opt{icons},
	'icons-ext|T!'	=>	\$opt{icons_ext},
	'icons-full|full-icons|I!'	
					=>	\$opt{icons_full},
	'icons-scale|scale-icons|S!'
					=>	\$opt{icons_scale},
	'icons-fork!'	=>	\$opt{icons_fork},
	'icons-dir|d=s'	=>	\$opt{icons_dir},
	'icons-oext|O=s'
					=>	\$opt{icons_oext},
	'text-icon=s'	=>	\$opt{text_icon},
	
	'wcnt-file=s'	=>	\$opt{wcnt_file},
	'termapp-class=s'
					=>	\$opt{termapp_class},
	'termapp-name=s'
					=>	\$opt{termapp_name},


	'utf8|u!'		=>	\$opt{utf},
	'encoding|E=s'	=>	\$opt{encoding},
	
	'clear|c!'		=>	\$opt{clear},
	'promote|p!'	=>	\$opt{promote},
	'strip|s!'		=>	\$opt{strip},
	'nomenu|m!'		=>	\$opt{nomenu},
	'only-in|o=s'	=>	\$opt{only_in},
	
	'xterm|r=s'		=>	\$opt{xterm},
	'convert|C=s'	=>	\$opt{convert},
	'full-regen|f!'	=>	\$opt{full_regen},
	'destdir|D=s'	=>	\$opt{destdir},
	); # }}}

if($o_help) { # {{{
	local $" = ", ";
	print<<EOF;
Usage:	$0 [options] {@wms}

Options:
    -h, --help	  - print this help and exit
    -V, --version	  - print version information and exit

  Diagnostics:
    -t, --tags    - echo omitted tags to stderr
    -e, --end     - echo omitted XDG file ending to stderr
    -v, --verbose - verbose stderr output

  Executables and icons:
    -x, --exec        - check for binaries existence
    -X, --exec-full   - extend binaries to full path (implies -x)
    -i, --icons       - add icons to menu (default: yes)
    -T, --icons-ext   - check for icons existence and add extension if required
    -I, --icons-full  - check for icons existence and extend to full path

    -S, --icons-scale - scale (shrink) icons (implies -i -I)
        --icons-fork  - scale icons after fork
    -d, --icons-dir=  - output dir for icons
    -O, --icons-oext= - output icons extension (default: png)

  Output encoding:
    -u, --utf8        - output in utf8 (default is locale setting)
    -E, --encoding=   - output in given encoding (e.g. iso-8859-2)

  Menu structure:
    -c, --clear    - remove empty menus
    -p, --promote  - promote submenus with single entry
    -s, --strip    - strip 1st level menu
    -m, --nomenu   - don't add additional menu info
                     (valid for blackbox, fluxbox, openbox, xfce4)
    -o, --only-in  - coma separated list of accepted OnlyShowIn= WMs

    -r, --xterm=   - set x terminal application
                     default: "$defopt{xterm}"
                     example "gnome-terminal -t Terminal.%1 -x %2"
    -C, --convert= - command to use to scale icons
                     default: "$defopt{convert}"

    -f, --full-regen - regenerate everything (delete scaled icons)
    -D, --destdir=   - directory to save multifile menu
EOF
	print "                       (used in: ",
		(join ", ", sort keys %destdir), ")\n";
	print<<EOF;

  All but diagnostics boolean options have oposite --no-<name> version too.

EOF
	exit;
} # }}}

if ($o_version) {
	(my $date = '$Date: 2006/04/19 00:02:33 $' ) =~ s/^.Date: (.*) \$$/$1/;
	print "VFolders Menu Generator version: $VERSION\n";
	print "Last update: $date\n";
	exit;
}

unless (exists $ARGV[0]) {
	local $" = ", ";
	die "Missing argument {@wms}\n";
}
$o_output=$ARGV[0];
die "Unrecognized argument: $o_output\n"
	unless grep { $o_output eq $_ } @wms;

# vfmgrc {{{
my @rcFiles = (qw(/etc/vfmgrc), "$ENV{'HOME'}/.vfmgrc");
push @rcFiles, "$ENV{'HOME_ETC'}/.vfmgrc" if exists $ENV{'HOME_ETC'};
@rcFiles = grep -r, @rcFiles;

my @rcBody;
foreach my $rc (@rcFiles) {
	open F_IN, $rc or next;
	my $read = 1;
	while (<F_IN>) {
		next if ( /^\s*#/ );
		$_ .= <F_IN> while s/\\\n$//;
		$read = 0 if /^\[/;
		if ( /^\[$o_output\]/ ) {
			$read = 1;
			next;
		}
		push @rcBody, $_ if $read;
	}
	close F_IN;
}

my %rcopt = map { /^\s*(.*?)\s*=\s*(.*)\s*$/ } @rcBody;
# }}}

foreach my $opt (keys %opt) {
	$opt{$opt} = $rcopt{$opt} unless defined $opt{$opt};
	$opt{$opt} = $defopt{$opt} unless defined $opt{$opt};
	next unless defined $opt{$opt};
	$opt{$opt} =~ s/\$\{HOME\}/$ENV{'HOME'}/go;
}

# check dependencies
$opt{exec}=1 if $opt{exec_full};
if ( grep { $o_output eq $_ } keys %iconsdir ) {
	$opt{icons_dir} = $iconsdir{$o_output} unless (length $opt{icons_dir});
}
if ($opt{icons_scale}) {
	if ( length $opt{icons_dir} ) {
		my $conv = (split /\s/, $opt{convert})[0];
		if ( length `which $conv` ) {
			$opt{icons} = 1;
			$opt{icons_full} = 1;
		} else {
			$opt{icons_scale} = 0;
			warn "$conv is not executable, not scaling icons.\n";
		}
	} else {
		$opt{icons_scale} = 0;
		warn "Icons destination directory is not specified, not scaling.\n";
	}
}
$opt{icons_ext} = 1 if $opt{icons_full};
$opt{encoding}="utf8" if $opt{utf};
if ( grep { $o_output eq $_ } keys %destdir ) {
	$opt{destdir} = $destdir{$o_output} unless (length $opt{destdir});
} else {
	delete $opt{destdir};
}
my @OSI_accept;
if ( defined $opt{only_in} ) {
	foreach my $cat ( split /[,\s]+/, $opt{only_in} ) {
		push @OSI_accept, $cat;
	}
}
# header }}}

# search dirs {{{
my @xdg_data_dirs = grep -d,
  ( exists $ENV{'XDG_DATA_HOME'}
	? $ENV{'XDG_DATA_HOME'}
	: "$ENV{'HOME'}/.local/share"
  ),
  ( exists $ENV{'XDG_DATA_DIRS'}
	? split /:+/, $ENV{'XDG_DATA_DIRS'}
	: qw(/usr/local/share /usr/share)
  );

my @xdg_config_dirs = map { "$_/menus" } grep -d,
  ( exists $ENV{'XDG_CONFIG_HOME'}
	? $ENV{'XDG_CONFIG_HOME'}
	: "$ENV{'HOME'}/.config"
  ),
  ( exists $ENV{'XDG_CONFIG_DIRS'}
	? split /:+/, $ENV{'XDG_CONFIG_DIRS'}
	: qw(/etc/xdg)
  );

my @icondirs = (
	grep (-d,
		"$ENV{'HOME'}/.icons/",
		map({"$_/icons/"} @xdg_data_dirs),
		qw(/usr/share/pixmaps/
		  /usr/share/icons/default.kde/48x48/apps/
		  /usr/share/icons/hicolor/48x48/apps/)
	),
	'',
);

my @path;
if ( $opt{exec} ) {
	@path=(grep (-d, split(/:+/,$ENV{'PATH'})), "");
	if( length $opt{xterm} ) {
		my $exists=0;
		my $bin=$opt{xterm};
		$bin=~s/(\S+).*/$1/;  #v---------v
		foreach my $dir(@path) {	 # would be "//dir/.../file" correct?
			if (-x "$dir/$bin") {#----^
				$exists=1;
				$opt{xterm}="$dir/$opt{xterm}" if $opt{exec_full};
				last;
			}
		}
		unless ($exists) {
			$opt{xterm}="";
			warn "Can't find $bin.",
				" Terminal applications will not be included.\n";
		}
	}
}
# search dirs }}}

# get locale (for Name[*]) {{{
my @lang;
sub addlang {
	my $l = $_[0];
	push @lang, $l unless grep {$_ eq $l} @lang;
	$l =~ s/@.*//;
	push @lang, $l unless grep {$_ eq $l} @lang;
	$l =~ s/\..*//;
	push @lang, $l unless grep {$_ eq $l} @lang;
	$l =~ s/_.*//;
	push @lang, $l unless grep {$_ eq $l} @lang;
}
addlang($ENV{'LC_ALL'})			if exists $ENV{'LC_ALL'};
addlang($ENV{'LC_MESSAGES'})	if exists $ENV{'LC_MESSAGES'};
if (exists $ENV{'LANGUAGE'}) {
	foreach my $lang (split /:/, $ENV{'LANGUAGE'}) {
		addlang($lang);
	}
}
addlang($ENV{'LANG'})	if exists $ENV{'LANG'};
my $langs = join "|", @lang;
sub findfirstlang {
	foreach my $lang (@lang) {
		foreach (@_) {
			return $_ if /\[$lang\]/;
		}
	}
	return (grep !/\[.*\]/, @_)[0];
} # }}}

# what is $DESKTOP_FILE_PATH?

my @apps;	# $apps{name}{category}=[icon,exec]
my @desktop;
find(\&wanted, grep -d, map {"$_/applications"} @xdg_data_dirs);

sub wanted { # {{{
	return unless -f && /^[^.].*\.desktop$/;
	my $file = $_;

	open F_IN, $file or warn "$File::Find::name: $!\n" and return;
	my %tags = (
		file		=> $file,
		Icon		=> '',
		Categories	=> '',
		Type		=> '',
		NoDisplay	=> 'false',
		map {
			## "foo = bar" or "Name[baz] = bar"
			/^\s*
			(Name(?:\[(?:$langs)\])?
			 |GenericName(?:\[(?:$langs)\])?
			 |Comment(?:\[(?:$langs)\])?
			 |Icon|Exec|Categories|Terminal|Type|Encoding|NoDisplay
			 |OnlyShowIn)
			\s* = \s* (.+?)
			\s*$/ox
		  } <F_IN>,
	);
	close F_IN;

	return unless lc $tags{Type} eq 'application';
	return if lc $tags{NoDisplay} eq 'true';
	if ( defined $tags{OnlyShowIn} ) {
		my $found = 0;
		foreach my $cat ( split /;+/, $tags{OnlyShowIn} ) {
			$found++ if grep {$cat eq $_} @OSI_accept;
		}
		return unless $found;
	}
	  
	$tags{term} =
	  ($tags{Terminal} && $tags{Terminal} =~ /^(?:1|true)$/i) ? 1 : 0;
	return if $tags{term} and not $opt{xterm};

	($tags{bin}) = ($tags{Exec} =~ /(\S+)/);    #v---------v
	if ( $opt{exec} ) {
		my $exists;
		foreach my $dir (@path) {    # would be "//dir/.../file" correct?
			if (-x "$dir/$tags{bin}") {    #----^
				$exists++;
				$tags{Exec} = "$dir/$tags{Exec}" if $opt{exec_full};
				last;
			}
		}
		return unless $exists;
	}
	if ( $tags{term} ) {
		$tags{bin} =~ s|.*/||;
		$_ = $opt{xterm};
		s/%1/$tags{bin}/;
		s/%2/$tags{Exec}/;
		$tags{Exec} = $_;
	}
	if ( $opt{icons_ext} ) {
		my $exists = 0;
		ALLDIRS: foreach my $dir (@icondirs) {
			foreach my $ext ('', qw(.svg .xpm .png)) {
				if (-f $dir . $tags{Icon} . $ext) {
					$tags{Icon} .= $ext;
					$tags{Icon} = $dir . $tags{Icon} if $opt{icons_full};
					$exists = 1;
					last ALLDIRS;
				}
			}
		}
		$tags{Icon} = '' unless $exists;
	}
	
	$tags{Encoding} = exists $tags{Encoding} ? $tags{Encoding} : 'iso-8859-1';
	
	my @to_decode = qw(Name);
	push @to_decode, qw(GenericName Comment)
		if $o_output eq "DR17" or $o_output eq "ASCII";
	foreach my $tag_name (@to_decode) {
		my @all = (grep /^$tag_name/, keys %tags);
		next if ($#all < 0);
		my $first = findfirstlang(@all);
		my $enc = $tags{Encoding};
	
		if ($enc eq 'Legacy-Mixed') {
			warn "$File::Find::name: Legacy-Mixed encoding is depreciated.\n";

			# this code is untested
			#    --radek
			my ($lang) = ($first =~ /^$tag_name\[([^\]]+)/);
			if ($lang !~ /_/) {
				warn "$File::Find::name: cannot get encoding name for"
				  . " `$lang'. Assuming iso-8859-1\n";
				$enc = "iso-8859-1";
			} else {
				require POSIX;
				my $old_locale = POSIX::setlocale(POSIX::LC_ALL());
				eval {
					POSIX::setlocale(POSIX::LC_ALL(), $lang);
					require I18N::Langinfo;
					$enc = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET());
				};
				warn "something went wrong: $@" if $@;
				POSIX::setlocale(POSIX::LC_ALL(), $old_locale);
			}
		}
		$tags{$tag_name} = decode($enc, $tags{$first});
		unless ($tags{$tag_name}) {
			warn "$File::Find::name: $first: wrong encoding!\n";
			$tags{$tag_name} = $tags{$first};
		}
	}
	$tags{file} =~ s/\.desktop$//;
	unless ($tags{Name}) {
		$tags{Name} = $tags{file};
		warn "$File::Find::name: missing Name tag! using $tags{Name}\n";
	}
	
	if ( $tags{Exec} =~ /%\S/ ) {
		$tags{Exec} =~ s/([^%])%v/$1/g;
		$tags{Exec} =~ s/([^%])%k/$1$file/g;
		$tags{Exec} =~ s/([^%])%c/$1$tags{Name}/g;
		my $iicon = '';
		$iicon = "--icon $tags{Icon}" if $tags{Icon};
		$tags{Exec} =~ s/([^%])%i/$1$iicon/g;
		$tags{Exec} =~ s/%(?i:[fudn])//g;
		warn "Unknown Exec parameter variable: $1 "
			."in $File::Find::name, removing\n"
		  if ($tags{Exec} =~ s/(%[^%\s])// and $o_verbose);
		$tags{Exec} =~ s/%%/%/g;
	}
	
	push @desktop, \%tags;
	#[$tags{file}, $tags{Name}, $tags{Icon}, $tags{Exec}, $tags{GenericName}, $tags{term}, $tags{bin}];
	
	$apps[$#desktop]{$_} = 1    # two apps can have same names now:)
	  foreach grep length, split /;+/, $tags{Categories};

} # }}}

# read XDG menu specification
my $file;
my $menu_file;
if ($ENV{'XDG_MENU_PREFIX'}) {
    $menu_file = "$ENV{'XDG_MENU_PREFIX'}applications.menu"
} else {
    $menu_file = "applications.menu";
}
foreach my $tmp (@xdg_config_dirs) {
	open F_IN, "$tmp/$menu_file" or next;
	local $/ = undef;
	($file = <F_IN>) =~ y/ \t\r\n//d;
	$file =~ s/<!--.*?-->//g;
	close F_IN;
	last;
}
unless (defined $file) {
	local $" = "\n- ";
	warn "No readable applications.menu in:\n- @xdg_config_dirs\n";
	die "Last error: $!\n";
}

sub gettag {
	$file=~s/.*?<(.*?)>\s*//;
	$1;
}

sub getname {
	$file=~s/\s*(.*?)\s*</</;
	$1;
}

my @menu; # $menu[parent]{dir number} = (menu number);
my $desknum = $#desktop;

# logic {{{
sub cand { # {{{
	my @iapps;	# internal applications list
	my $name;
	my $firstrun=1;
	while ( (my $tag = gettag()) ne '/And') {
		if($tag eq 'Category') {
			my $dir=getname();
			if($firstrun) {
				foreach $name(0..$desknum) {
					$iapps[$name]=$apps[$name] if exists $apps[$name]{$dir};
				}
				$firstrun=0;
			} else {
				foreach $name(0..$#iapps) {
					delete($iapps[$name]) unless exists $iapps[$name]{$dir};
				}
			}
			gettag();	# must be </category> else GIGO and we don't care
			next;
		}
		if($tag=~/^(And|Or|Not)$/) {
			my $tmpapps;
			if ($tag eq 'Or') {
				$tmpapps=cor();
			} elsif ($tag eq 'And') {
				$tmpapps=cand();
			} else {
				$tmpapps=cnot();
			}
			if($firstrun) {
				foreach $name(0..$#$tmpapps) {
					$iapps[$name]=$apps[$name] if defined $tmpapps->[$name];
				}
				$firstrun=0;
			} else {
				foreach $name(0..$#iapps) {
					delete($iapps[$name]) unless defined $tmpapps->[$name];
				}
			}
			next;
		}
		warn "warning: possible XDG file corruption!: $tag\n" if $o_verbose;
	}
	\@iapps;
} # }}}

sub cor { # {{{
	my @iapps;	# internal applications list
	my $name;
	while ( (my $tag = gettag()) ne '/Or') {
		if($tag eq 'Category') {
			my $dir=getname();
			foreach $name(0..$desknum) {
				$iapps[$name]=1 if exists $apps[$name]{$dir};
			}
			gettag();	# must be </category> else GIGO and we don't care
			next;
		}
		if($tag=~/^(And|Or|Not)$/) {
			my $tmpapps;
			if ($tag eq 'Or') {
				$tmpapps=cor();
			} elsif ($tag eq 'And') {
				$tmpapps=cand();
			} else {
				$tmpapps=cnot();
			}
			foreach $name(0..$#$tmpapps) {
				$iapps[$name]=1 if defined $tmpapps->[$name];
			}
			next;
		}
		warn "warning: possible XDG file corruption!: $tag\n" if $o_verbose;
	}
	\@iapps;
} # }}}

sub cnot { # {{{
	my @iapps;	# internal applications list
	my $name;
	@iapps=@apps;
	while ( (my $tag = gettag()) ne '/Not') {
		if($tag eq 'Category') {
			my $dir=getname();
			foreach $name(0..$#iapps) {
				delete($iapps[$name]) if exists $iapps[$name]{$dir};
			}
			gettag();	# must be </category> else GIGO and we don't care
			next;
		}
		if($tag=~/^(And|Or|Not)$/) {	# I think it doesn't make any sense
			warn "How did you get here!?\n" if $o_verbose;
			my $tmpapps;
			if ($tag eq 'Or') {
				$tmpapps=cor();
			} elsif ($tag eq 'And') {
				$tmpapps=cand();
			} else {
				$tmpapps=cnot();
			}
			foreach $name(0..$#iapps) {
				delete($iapps[$name]) if defined $tmpapps->[$name];
			}
			next;
		}
		warn "warning: possible XDG file corruption!: $tag\n" if $o_verbose;
	}
	\@iapps;
} # }}}
# logic }}}

# parse menu file {{{
my @tmp=grep -d, map {"$_/desktop-directories/"} @xdg_data_dirs;
sub include($) { # {{{
	my ($mno) = @_;
	while ( (my $tag = gettag()) ne "/Include" ) {
		if($tag eq 'Category') {
			my $dir=getname();
			foreach my $name(0..$desknum) {
				$menu[$mno]{$name}=-1
					if exists $apps[$name]{$dir};
			}
			gettag();	# must be </category> else GIGO and we don't care
			next;
		}
		if($tag=~/^(And|Or|Not)$/) {
			my $tmpapps;
			if ($tag eq 'Or') {
				$tmpapps=cor();
			} elsif ($tag eq 'And') {
				$tmpapps=cand();
			} else {
				$tmpapps=cnot();
			}
			foreach my $name(0..$#$tmpapps) {
				next unless defined $tmpapps->[$name];
				foreach my $dir (keys %{$apps[$name]}) {
					$menu[$mno]{$name}=-1;
				}
			}
			next;
		}
		if( $o_verbose &&
			( $tag=~/^\/(name|directory|and|or|not|category|mergefile)$/i )) {
			warn "warning: XDG file corrupted!\n";
		}
		warn "Omitted tag: $tag\n" if $o_tags;
	}
} # }}}

sub menu($);
sub menu($) { # {{{
	my ($parent_number) = @_;
	my $name;
	$#desktop++;
	my $dirnum = $#desktop;
	$#menu++;
	my $mno = $#menu;
	# $dirnum = $desknum + $mno;
	my $ignore = 0;

	while ( (my $tag = gettag()) ne "/Menu" ) {
		if($tag eq 'OnlyUnallocated/') {
			$ignore = 1;
		}
		if($tag eq 'Include') {
			include($mno);
			next;
		}
		if($tag eq 'Menu') {
			menu($mno);
			next;
		}
		if($tag eq 'Name') {
			$name = getname();
			gettag();	# must be </name> else GIGO and we don't care
			next;
		}
		if($tag eq 'Directory') {
			my $dirfile = getname();
			my $dname="";
			my $ok=0;
			foreach my $tmp (@tmp) {
				open F_IN, $tmp. $dirfile or next;
				my %tags = (
					Name		=> '',
					Icon		=> '',
					Encoding	=> "iso-8859-1",
					map {
							## "foo = bar" or "Name[baz] = bar"
							/^\s*
							(Name(?:\[(?:$langs)\])?
							 |Icon|Encoding)
							\s* = \s* (.+?)
							\s*$/ox
						} <F_IN>,
					);
				$dname = $tags{findfirstlang( grep /^Name/, keys %tags)};
				close F_IN;
				$ok = 1;
				
				if($opt{icons_ext}) {
					my $exists = 0;
					ALLDIRS: foreach my $dir (@icondirs) {
						foreach my $ext ('', qw(.svg .xpm .png)) {
							if (-f $dir . $tags{Icon} . $ext) {
								$tags{Icon} .= $ext;
								$tags{Icon} = $dir . $tags{Icon}
									if $opt{icons_full};
								$exists = 1;
								last ALLDIRS;
							}
						}
					}
					$tags{Icon} = '' unless $exists;
				}
				if ( length $dname ) {
					$tags{Name} = decode($tags{Encoding},$dname);
					unless($tags{Name}) {
						warn "$dirfile: wrong encoding!\n";
						$tags{Name} = $dname;
					}
				} else {
					warn "$dirfile: missing Name tag!\n";
					$tags{Name}=$name;
				}
				($tags{file} = $dirfile) =~ s/\..*?$//;
				$desktop[$dirnum] = \%tags;
				#[$tags{file}, $tags{Name}, $tags{Icon}];
				last;
			}
			unless ($ok) {
				local $" = "\n- ";
				warn "No readable $dirfile in:\n- @tmp\n";
				warn "Last error: $!\n";
			}
			gettag();	# must be </directory> else GIGO and we don't care
			next;
		}
		if($tag eq 'MergeFile') {
			my $name = getname();
			gettag();	# must be </mergefile> else GIGO and we don't care
			my $ok;
			foreach my $tmp (@xdg_config_dirs, '') {
				open F_IN, "$tmp/$name" or next;
				local $/ = undef;
				($ok = <F_IN>) =~ y/ \t\r\n//d;
				close F_IN;
				$ok =~ s/<!--.*?-->//g;
				$file = $ok . $file;
				last;
			}
			unless (defined $ok) {
				local $" = "\n- ";
				warn "No readable $name in:\n- @xdg_config_dirs\n";
				warn "Last error: $!\n";
			}
			next;
		}
		if( $o_verbose &&
			( $tag=~/^\/(name|directory|and|or|not|category|mergefile)$/i )) {
			warn "warning: XDG file corrupted!\n";
		}
		warn "Omitted tag: $tag\n" if $o_tags;	
	}

	return if ($ignore);

	# if there was no <Directory>
	$desktop[$dirnum] = {
		file => $name,
		Name => $name,
		Icon => ''
	} unless defined $desktop[$dirnum];
	#[$name,$name,""] 
	
	$menu[$parent_number]{$dirnum} = $mno;
} # }}}

$#menu++;
while( (my $tag = gettag()) ne "Menu" ) {
	warn "Omitted tag: $tag\n" if $o_tags;
}
menu(0);

warn "Omitted ending: $file\n" if(($file ne "")&& $o_end);
# parse menu file }}}

if ( $opt{clear} and not $opt{promote} ) { # {{{
	my @empty;
	for(my $i=$#menu; $i>=0; $i--) {
		$empty[$i]=1;
		foreach my $entry(keys %{$menu[$i]}) {
			my $mno = $menu[$i]{$entry};
			if($mno<0) {
				$empty[$i]=0;
			} else {
				if($empty[$mno]) {
					delete($menu[$i]{$entry});
				} else {
					$empty[$i]=0;
				}
			}
		}
	}
} #}}}

if ( $opt{promote} ) { # {{{
	my @count;
	for ( my $i = $#menu; $i >= 0; $i-- ) {
		$count[$i] = 0;
		foreach my $entry ( keys %{$menu[$i]} ) {
			my $mno = $menu[$i]{$entry};
			if ( $mno < 0 ) {
				$count[$i]++;
			} else { # submenu
				if ( $count[$mno] == 0 ) {
					delete( $menu[$i]{$entry} );
				} else {
					if ( $count[$mno] == 1 ) { #only one entry in submenu
						foreach my $name ( keys %{$menu[$mno]} ) {
#							warn "Promoting: $desktop[$name][1] --> $desktop[$entry][1]\n" if $o_verbose;
							$desktop[$name]{Name} = $desktop[$entry]{Name} 
								. " / " . $desktop[$name]{Name};
							if ( $menu[$mno]{$name} == -1 ) { # it's aplication
								$menu[$i]{$name} = -1;
							} else {
								$menu[$i]{$name} = $menu[$mno]{$name};
								delete( $menu[$mno]{$name} );
							}
						}
						delete( $menu[$i]{$entry} );
					}
					$count[$i]++;
				}
			}
		}
	}
} # }}}

my @scale;
sub scale_icon {
	my $icon_in = $_[0];
	return $icon_in unless $opt{icons_scale};
	return $icon_in unless -r $icon_in;
	
	(my $icon_out = $icon_in ) =~ s/^.*\///;
	$icon_out =~ s/\..*$//;
	$icon_out = "$opt{icons_dir}/$icon_out.$opt{icons_oext}";
	
	unless (-f $icon_out) {
		$_ = $opt{convert};
		s/\%in/$icon_in/g;
		s/\%out/$icon_out/g;
		
		if ( $opt{icons_fork} ) {
			push @scale, $_;
		} else {
			system($_);
		}
	}
	return $icon_out;
}

# WM functions {{{
use constant step		=> "\t";

sub cmpdname {
	use locale;
	return 
			encode($opt{encoding}, $desktop[$a]{Name} )
		cmp
			encode($opt{encoding}, $desktop[$b]{Name} )
		;
}

sub ASCII { # {{{
	my ($no, $level, $cnum)=@_;
	my $cnext = $cnum + 1;
	my @apps;
	my @tmp = ();
	@tmp = %{$menu[$no]} if %{$menu[$no]};
	my $all = ($#tmp + 1) / 2;
	my $num = 0;
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		$num++;
		if($menu[$no]{$entry} < 0) {
			push @apps, $d;
		} else {
			my $step = " \033[${cnum}m\033(0\017x\033(B\033[0m ";
			if ($num >= $all and ( $#apps < 0 )) {
				$step = "   ";
				print "$level \033[${cnum}m\033(0mq\033(B\033[${cnext}m\033[1m[$$d{Name}]";
			} else {
				print "$level \033[${cnum}m\033(0tq\033(B\033[${cnext}m\033[1m[$$d{Name}]";
			}
			print " ($$d{GenericName})" if $$d{GenericName};
			print " [$$d{Comment}]" if $$d{Comment};
			print "\033[0m\n";
			ASCII($menu[$no]{$entry},$level.$step, $cnext);
		}
	}
	$num = 0;
	foreach my $d (@apps) {
		if ($num >= $#apps) {
			print "$level \033[${cnum}m\033(0\017mq\033(B\033[${cnext}m$$d{Name}";
		} else {
			print "$level \033[${cnum}m\033(0\017tq\033(B\033[${cnext}m$$d{Name}";
		}
		print " ($$d{GenericName})" if $$d{GenericName};
		print " [$$d{Comment}]" if $$d{Comment};
		print "\033[0m\n";
		$num++;
	}
} # }}}

sub DR17 { # {{{
	my ($no, $dir, $tab, $dr)=@_;
	my $dirs = "";
	my $apps = "";
	my @edje = qw(edje_cc -id . -fd . icon.edc);
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $icon_exists = 0;
		my $d = $desktop[$entry];
		my $name = $$d{Name};
		print $tab.$name.".." if $o_verbose;
		my $icon = $$d{Icon};

		if ( defined $dr->{existing}->{$$d{file}} ) {
			my $e = $dr->{existing}->{$$d{file}};
			if ( 
				(
					(not defined $$e{Name} and not defined $$d{Name}) 
						or ($$e{Name} eq $$d{Name})
				)
				and
				(
					(not defined $$e{GenericName} and not defined $$d{GenericName})
						or ($$e{GenericName} eq $$d{GenericName})
				)
				and
				(
					(not defined $$e{Comment} and not defined $$d{Comment})
						or ($$e{Comment} eq $$d{Comment})
				)
				and
				(
					(not defined $$e{Exec} and not defined $$d{Exec})
						or ($$e{Exec} eq $$d{Exec} )
				)
			)
			{
				if ( -r $icon ) {
					(my $md5 = `md5sum $icon`) =~ s/\s+.*//s;
					if ( defined $$e{IconMD5} ) {
						$icon_exists = 1 if ( $md5 eq $$e{IconMD5} );
					}
				} else {
					$icon_exists = 1 unless defined $$e{IconMD5};
				}
			}
		}
		
		unless ( $icon_exists ) {
			delete $dr->{existing}->{$$d{file}}
				if exists $dr->{existing}->{$$d{file}};
			my $md5;
			if ( -r $icon ) {
				($md5 = `md5sum $icon`) =~ s/\s+.*//s;
			}
			my $e = {
				Name	=> $$d{Name},
				GenericName	=> $$d{GenericName},
				Comment	=> $$d{Comment},
				Exec	=> $$d{Exec},
				IconMD5	=> $md5
			};
			$dr->{existing}->{$$d{file}} = $e;
			
			unlink $$dr{icon};
			if ( not -r $icon and defined $$dr{text_icon} ) {
				( my $exe = $$dr{text_icon} ) =~ s/%1/"$name"/;
				system($exe);
			} else {
				$icon = $$dr{tmp}."/blank.xpm" unless -r $icon;
				scale_icon($icon);
			}
			die "No icon $$dr{icon}\n" unless -r $$dr{icon};
			print ".." if $o_verbose;
		}
		
		if($menu[$no]{$entry} < 0) {
			if ( $icon_exists ) {
				$apps .= $$d{file} . ".eap\n";
				print "..EXISTS\n" if $o_verbose;
				next;
			}
			my $file = "$opt{icons_dir}/$$d{file}.eap";

			system(@edje,$file);
			print ".." if $o_verbose;
			my @eapp = qw(enlightenment_eapp);
			push @eapp, $file;
			push @eapp, "-set-name",$name;
			push @eapp, "-set-generic",$$d{GenericName}
				if $$d{GenericName};
			push @eapp, "-set-comment",$$d{Comment}
				if $$d{Comment};
			push @eapp, "-set-exe",$$d{Exec};
			if ( defined $$dr{wcnt} ) {
				if ( exists $$dr{wcnt}{$$d{file}} ) {
					my $wcnt = $$dr{wcnt}{$$d{file}};
					push @eapp, "-set-win-class", $$wcnt[0]
						if defined $$wcnt[0];
					push @eapp, "-set-win-name", $$wcnt[1] if defined $$wcnt[1];
					push @eapp, "-set-win-title", $$wcnt[2]
						if defined $$wcnt[2];
					push @eapp, "-set-win-role", $$wcnt[3] if defined $$wcnt[3];
				} else {
					if ( $$d{term} == 1 ) {
						if ( defined $opt{termapp_class} ) {
							(my $tapp = $opt{termapp_class}) =~ s/%1/$$d{bin}/;
							push @eapp, "-set-win-class", $tapp;
						}
						if ( defined $opt{termapp_name} ) {
							(my $tapp = $opt{termapp_name}) =~ s/%1/$$d{bin}/;
							push @eapp, "-set-win-name", $tapp;
						}
					} else {
						my $exe = (split /\s/, $$d{Exec})[0];
						$exe = ucfirst lc $exe;
						push @eapp, "-set-win-class", $exe;
					}
				}
			}
			system(@eapp);
			
			print "..DONE\n" if $o_verbose;
			$apps .= $$d{file} . ".eap\n";
		} else {
			my $subdir = sprintf "%s/%s", $dir, $$d{file};
			my $file = $subdir . "/.directory.eap";
			my $file2 = "$opt{icons_dir}/$$d{file}.eap";
			mkpath($subdir,0,0700);
			print ".." if $o_verbose;
			unless ( $icon_exists ) {
				system(@edje, $file2);
				print ".." if $o_verbose;
				system("enlightenment_eapp",$file2,
					"-set-name",$name);
			}
			symlink ($file2, $file);
			print "..DONE\n" if $o_verbose;
			DR17($menu[$no]{$entry},$subdir,$tab.step,$dr);
			$dirs .= $$d{file}."\n";
		}
	}
	open F_OUT, ">> $dir/.order" or warn "$dir/.order: $!\n";
	print F_OUT $dirs;
	print F_OUT $apps;
	close F_OUT;	
} # }}}

sub aewm { # {{{
	my ($no, $level)=@_;
	my $apps="";
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		( my $name = $$d{Name} ) =~ s/\"/\\\"/g;
		if($menu[$no]{$entry} < 0) {
			( my $exec = $$d{Exec} ) =~ s/\"/\\\"/g;
			$apps .= qq(${level}cmd "$name" "$exec"\n);
		} else {
			print qq(${level}menu "$name"\n);
			aewm($menu[$no]{$entry},$level.step);
			print "${level}end\n";
		}
	}
	print $apps;
} # }}}

sub afterstep { # {{{
	my ($no, $dir)=@_;
	
	foreach my $entry(keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		my $name = encode($opt{encoding},$$d{Name});
		if($menu[$no]{$entry} < 0) {
			$name=~s/\"/\\\"/g;
			my $icon = "";
			$icon = scale_icon($$d{Icon}) if $opt{icons};
			my $F_OUT;
			open $F_OUT, ">> $dir/$$d{file}" or warn "$dir/$$d{file}: $!\n";
			print $F_OUT qq(Exec "$name" exec $$d{Exec}\n);
			print $F_OUT qq(MiniPixmap "$icon"\n) if length $icon;
			close $F_OUT;
		} else {
			$name =~ s|/||g;
			mkpath("$dir/$name",0,0700);
			afterstep($menu[$no]{$entry},"$dir/$name");
		}
	}
} # }}}

sub blackbox { # {{{
	my ($no, $level)=@_;
	my $apps="";
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		if($menu[$no]{$entry} < 0) {
			$apps .= "$level"."[exec] ($$d{Name}) {$$d{Exec}}\n";
		} else {
			print "$level"."[submenu] ($$d{Name})\n";
			blackbox($menu[$no]{$entry}, $level.step);
			print "$level\[end]\n";
		}
	}
	print $apps;
} # }}}

sub enlightenment { # {{{
	my ($no, $mfile, $title)=@_;
	my $F_OUT;
	open $F_OUT, ">> $opt{destdir}/$mfile.menu" or warn "$opt{destdir}/$mfile.menu: $!\n";
	print $F_OUT qq("$title"\n);
	my $apps="";
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		my $name = encode($opt{encoding},$$d{Name});
		$name=~s/\"/\'/g;
		my $icon="";
		$icon = scale_icon($$d{Icon}) if $opt{icons};
		if($menu[$no]{$entry}<0) {
			$apps .= qq("$name" "$icon" exec "$$d{Exec}"\n);
		} else {
			print $F_OUT qq("$name" "$icon" menu "$opt{destdir}/$$d{file}.menu"\n);
			enlightenment($menu[$no]{$entry},$$d{file},$name);
		}
	}
	print $F_OUT $apps;
	close $F_OUT;
} # }}}

sub fbpanel { # {{{
	my ($no, $level)=@_;
	my $apps="";
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		my $icon = "";
		$icon = scale_icon($$d{Icon}) if $opt{icons};
		if($menu[$no]{$entry}<0) {
			$apps .=
				"${level}item {\n".
				"${level}	name = $$d{Name}\n".
				"${level}	action = $$d{Exec}\n";
			$apps .= "${level}	image = $icon\n" if length $icon;
			$apps .= "${level}}\n";
		} else {
			print "${level}menu {\n";
			print "${level}	name = $$d{Name}\n";
			print "${level}	image = $icon\n" if length $icon;
			fbpanel($menu[$no]{$entry},$level.step);
			print "${level}}\n";
		}
	}
	print $apps;
} # }}}

sub fvwm { # {{{
	my ($no, $file, $basename)=@_;
	$file=~s|^\.||;
	
	my $apps = "";
	my $this_menu = "";
	$this_menu .= qq(Popup "$file"\n\tTitle "$basename"\n);
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		if($menu[$no]{$entry} < 0) {
			my $name = $$d{Name};
			$name =~ s/\"/\\\"/g;
			$apps .= qq(\tExec "$name"\texec $$d{Exec}\n);
		} else {
			my $name = $$d{file};
			$name =~ s/\s+/_/g;
			$this_menu .= qq(\tPopup "$$d{Name}"\t$file.$name\n);
			fvwm($menu[$no]{$entry},"$file.$name",$$d{Name});
		}
	}
	print $this_menu . $apps . "EndPopup\n\n" if length $file;
} # }}}

sub fvwm2 { # {{{
	my ($no, $level)=@_;
	my $apps="";
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		( my $name = $$d{Name} ) =~ s/\"/\\\"/g;
		my $icon = "";
		$icon = scale_icon($$d{Icon}) if $opt{icons};
		$icon = "\%$icon\%" if length $icon;
		if($menu[$no]{$entry}<0) {
			$apps .= qq(AddToMenu $level	"$icon$name"	Exec $$d{Exec} &\n);
		} else {
			my $file = $$d{file};
			$file =~ s/\s+/_/g;
			print qq(AddToMenu $level	"$icon$name"	Popup $level.$file\n);
			print "DestroyMenu recreate $level.$file\n\n";
			print qq(AddToMenu $level.$file	"$icon$name"	Title\n);
			fvwm2($menu[$no]{$entry},"$level.$file");
		}
	}
	print $apps."\n";
} # }}}

sub icewm { # {{{
	my ($no, $level)=@_;
	my $apps="";
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		my $name = $$d{Name};
		$name =~ s/\"/\\\"/g;
		my $icon = "";
		$icon = scale_icon($$d{Icon}) if $opt{icons};
		if($menu[$no]{$entry} < 0) {
			$apps .= qq(${level}prog "$name" "$icon" $$d{Exec}\n);
		} else {
			$icon = "folder" if not length $icon and $opt{icons};
			print qq(${level}menu "$name" "$icon" {\n);
			icewm($menu[$no]{$entry}, $level.step);
			print "$level}\n";
		}
	}
	print $apps;
} # }}}

sub metisse { # {{{
	my ($no, $file, $basename) = @_;
	$file =~ s|^\.||;
	
	my $apps = "";
	my $this_menu = "";
	$this_menu .= qq(DestroyMenu $file\nAddToMenu $file "$basename" Title\n);
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		my $icon = "";
		$icon = scale_icon($$d{Icon}) if $opt{icons};
		$icon = "\%$icon\%" if length $icon;
		
		if($menu[$no]{$entry} < 0) {
			( my $name = $$d{Name} ) =~ s/\"/\\\"/g;
			$apps .= qq(+ "$icon$name"\tExec exec $$d{Exec}\n);
		} else {
			( my $name = $$d{file} ) =~ s/\s+/_/g;
			$this_menu .= qq(+ "$icon$$d{Name}"\tPopup\t$file.$name\n);
			metisse($menu[$no]{$entry},"$file.$name",$$d{Name});
		}
	}
	print $this_menu . $apps . "\n" if length $file;
} # }}}

sub olvwm { # {{{
	my ($no, $level)=@_;
	my $apps="";
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		( my $name = $$d{Name} ) =~ s/\"/\\\"/g;
		if($menu[$no]{$entry}<0) {
			$apps .= qq($level"$name"	exec $$d{Exec}\n);
		} else {
			print qq($level"$name" MENU\n);
			olvwm($menu[$no]{$entry},$level.step);
			print qq($level"$name" END PIN\n);
		}
	}
	print $apps;
} # }}}

sub openbox { # {{{
	my ($no, $level)=@_;
	my $apps="";
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		if($menu[$no]{$entry}<0) {
			$apps .=
				qq($level<item label="$$d{Name}">\n).
				qq($level	<action name="Execute">\n).
				qq($level	 <execute>$$d{Exec}</execute>\n).
				qq($level	</action>\n).
				qq($level</item>\n);
		} else {
			print qq($level<menu id="$$d{Name}" label="$$d{Name}">\n);
			openbox($menu[$no]{$entry},$level.step);
			print "$level</menu>\n";
		}
	}
	print $apps;
} # }}}

sub qvwm { # {{{
	my ($no, $level)=@_;
	my $apps="";
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		( my $name = $$d{Name} ) =~ s/\"/\\\"/g;
		my $icon = "";
		$icon = scale_icon($$d{Icon}) if $opt{icons};
		if($menu[$no]{$entry} < 0) {
			( my $exec = $$d{Exec} ) =~ s/\"/\\\"/g;
			$apps .= qq($level"$name" "$icon" "$exec"\n);
		} else {
			print qq($level"$name" "$icon"\n),
				"$level+\n";
			qvwm($menu[$no]{$entry},$level.step);
			print "$level-\n";
		}
	}
	print $apps;
} # }}}

sub wmaker { # {{{
	my ($no, $coma, $level)=@_;
	my $apps="";
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		my $name = $$d{Name};
		$name =~ s/\"/\\\"/g;
		if($menu[$no]{$entry} < 0) {
			(my $exec = $$d{Exec}) =~ s/\"/\\\"/g;
			$apps .= "$coma\n".
				qq{$level("$name", EXEC, "$exec")};
		} else {
			print "$coma\n",
				qq{$level("$name"};
			wmaker($menu[$no]{$entry},",",$level.step);
			print "\n$level)";
		}
	}
	print $apps;
} # }}}

sub wmakerold { # {{{
	my ($no, $level)=@_;
	my $apps="";
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		my $name = $$d{Name};
		$name =~ s/\"/\\\"/g;
		if($menu[$no]{$entry} < 0) {
			$apps .= qq($level"$name" EXEC $$d{Exec}\n);
		} else {
			print qq($level"$name" MENU\n);
			wmakerold($menu[$no]{$entry}, $level.step);
			print qq($level"$name" END\n);
		}
	}
	print $apps;
} # }}}

sub wmii { # {{{
	my ($no, $level)=@_;
	my @apps;
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		(my $name = encode($opt{encoding}, $$d{Name})) =~ s#/#:#g;
		if($menu[$no]{$entry} < 0) {
			push @apps, [$name, $$d{Exec}];
		} else {
			system("wmiir", "create", "/menu/items/menu" . $level . "/items/" .
				$name . " [>",
				"wmiir write /menu/lookup /items/menu" . $level."/".$$d{file}
				. "/items; wmiir write /menu/ctl 'display 1'");
				
			wmii($menu[$no]{$entry}, $level ."/". $$d{file} );
		}
	}
	foreach my $app (@apps) {
		system("wmiir", "create",
			"/menu/items/menu" . $level . "/items/" . $$app[0],
			$$app[1]);
	}
} # }}}

# sub xfce4 { {{{
sub xmlname($) {
	$_ = $_[0];
	s/&/&amp;/g;
	s/\"/&quot;/g;
	s/</&lt;/g;
	s/>/&gt;/g;
	return $_;
}
sub xfce4 {
	my ($no, $level)=@_;
	my $apps="";
	foreach my $entry (sort cmpdname keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		my $name = ($$d{Name} =~ /["&<>]/) ?
			xmlname($$d{Name}) : $$d{Name};
		my $icon = "";
		$icon = scale_icon($$d{Icon}) if $opt{icons};
		if($menu[$no]{$entry} < 0) {
			$apps .= qq($level<app name="$name" cmd=");
			$apps .= ($$d{Exec} =~ /["&<>]/) ? xmlname($$d{Exec}) : $$d{Exec};
			$apps .= qq(" icon="$icon"/>\n);
		} else {
			print qq($level<menu name="$name" icon="$icon" visible="yes">\n);
			xfce4($menu[$no]{$entry},$level.step);
			print "$level</menu>\n";
		}
	}
	print $apps;
} # }}}

sub xpde { # {{{
	my ($no, $dir)=@_;
	foreach my $entry (keys %{$menu[$no]}) {
		my $d = $desktop[$entry];
		my $name = encode($opt{encoding},$$d{Name});
		if($menu[$no]{$entry} < 0) {
			$name =~ s/\"/\\\"/g;
			my $icon = "";
			$icon = scale_icon($$d{Icon}) if $opt{icons};
			open F_OUT, ">> $dir/$$d{file}.lnk" or warn "$dir/$$d{file}.lnk: $!\n";
			print F_OUT "[Shortcut]\n",
						"Caption=$name\n",
						"Command=$$d{Exec}\n";
			print F_OUT "Icon=$icon\n" if length $icon;
			close F_OUT;
		} else {
			$name =~ s|/||g;
			mkpath("$dir/$name",0,0700);
			xpde($menu[$no]{$entry},"$dir/$name");
		}
	}
} # }}}
# WM functions }}}

unless (length $opt{encoding}) {
	require I18N::Langinfo;
	I18N::Langinfo->import(qw(langinfo CODESET));
	$opt{encoding} = langinfo(CODESET());
}
binmode STDOUT, ":encoding($opt{encoding})";

if ($opt{icons_scale}) {
	if (not -d $opt{icons_dir} or $opt{full_regen}) {
		warn "Nead to generate all icons.\n";
		require File::Path;
		import File::Path qw(mkpath rmtree);
		rmtree($opt{icons_dir}.".old",0,0) if -e $opt{icons_dir}.".old";
		rename($opt{icons_dir},$opt{icons_dir}.".old") if -e $opt{icons_dir};
		mkpath($opt{icons_dir},0,0700);
	}
}
if (exists $opt{destdir}) {
	warn "Multi file output.\n";
	require File::Path;
	import File::Path qw(mkpath rmtree);
	rmtree($opt{destdir}.".old",0,0) if -e $opt{destdir}.".old";
	rename($opt{destdir},$opt{destdir}.".old") if -e $opt{destdir};
	mkpath($opt{destdir},0,0700);
}

# WM case {{{
if ( $o_output eq "ASCII" ) {
	print "\n\033[31m\033[1m[Menu]\033[0m\n";
	ASCII($opt{strip},"", 31);
}
elsif ( $o_output eq "DR17" ) { # {{{
	die "Enlightenment DR17 requires icons scaling\n"
		unless $opt{icons_scale};
	die "Enlightenment DR17 conflicts with icons fork\n"
		if $opt{icons_fork};
	
	$| = 1;
	print "Generating DR17 menu, this may take a long time\n";
	my %DR;
	$DR{tmp} = $ENV{'TMPDIR'};
	$DR{tmp} = $ENV{'TMP'}  unless -d $DR{tmp};
	$DR{tmp} = "/tmp"  unless -d $DR{tmp};
	$DR{icon} = $DR{tmp}."/icon.".$opt{icons_oext};
	
	$opt{convert} =~ s/\%out/$DR{icon}/g;
	chdir($DR{tmp});
	unlink $DR{icon};
	# icon is allways neaded
	open F_OUT, "> blank.xpm"; # {{{
	print F_OUT <<EOF;
		static char *blank[] = {
			"1 1 1 1",
			". c None",
			"."
		};
EOF
	close F_OUT; # }}}
	open F_OUT, "> icon.edc"; # {{{
	print F_OUT << "EOF";
	images {
		image: "icon.$opt{icons_oext}" COMP;
	}
	collections {
		group {
			name: "icon";
			max: 48 48;
			 parts {
				part {
					name: "image";
					mouse_events: 0;
					description {
						state: "default" 0.0;
						aspect: 1.0 1.0;
						image.normal: "icon.$opt{icons_oext}";
					}
				}
			}
		}
	}
EOF
	close F_OUT; # }}}
	
	$opt{wcnt_file} = "" unless defined $opt{wcnt_file};
	$DR{wcnt} = {};
	foreach my $wcnt_file (split /\s*;\s*/, $opt{wcnt_file}) { # {{{
		unless (open F_IN, $wcnt_file) {
			warn "Can't open WCNT file: $!\n";
			next;
		}
		while ( <F_IN> ) {
			next if /^\s*#/;
			next unless s/^\s*(\S+)//;
			my $name = $1;
			$DR{wcnt}{$name} = [undef, undef, undef];
			foreach my $num (0..3) {
				last unless s/^\s*"(([^"]|\")*?[^\\])"// or s/^\s*(\S+)//;
				$DR{wcnt}{$name}[$num] = $1 unless $1 eq "*";
			}
			warn "Omitted: $_\n" if length($_) and $o_verbose;
		}
		close F_IN;
	} # }}}
	$DR{wcnt} = undef unless %{$DR{wcnt}};
	
	$DR{text_icon} = $opt{text_icon};
	if ( defined $DR{text_icon} ) {
		$DR{text_icon} =~ s|\%in|$DR{tmp}/blank.xpm|g;
		$DR{text_icon} =~ s|\%out|$DR{icon}|g;
	}

	$DR{existing} = {};
	if (open F_IN, "$opt{icons_dir}/.existing") {
		my $icon = "broken?";
		while (my $line = <F_IN>) {
			if ( $line =~ /^\[(.*)\]$/ ) {
				$icon = $1;
				$DR{existing}->{$icon} = {};
			} elsif ( $line =~ /^(\S+?):\t(.*)$/ ) {
				$DR{existing}->{$icon}->{$1} = $2;
			}
		}
		close F_IN;
	}

	DR17($opt{strip},$opt{destdir},"",\%DR);
	unlink "blank.xpm";
	unlink "icon.edc";
	unlink $DR{icon};
	unlink "$opt{icons_dir}/.eap.cache.cfg"
		if -r "$opt{icons_dir}/.eap.cache.cfg";
	for my $dir (qw(all bar favorite restart startup)) {
		unlink "$opt{destdir}/../$dir/.eap.cache.cfg"
			if -r "$opt{destdir}/../$dir/.eap.cache.cfg";
	}
	utime undef, undef, "$opt{destdir}/../bar/.order";

	open F_OUT, "> $opt{icons_dir}/.existing";
	foreach my $icon ( keys %{$DR{existing}} ) {
		print F_OUT "[$icon]\n";
		foreach my $entry ( keys %{$DR{existing}->{$icon}} ) {
			print F_OUT "$entry:	$DR{existing}->{$icon}->{$entry}\n"
				if defined $DR{existing}->{$icon}->{$entry};
		}
	}
	close F_OUT;
	
	exit;
} # }}}
elsif($o_output eq "aewm") {
	aewm($opt{strip},"");
}
elsif($o_output eq "afterstep") {
	afterstep($opt{strip},$opt{destdir});
}
elsif($o_output eq "blackbox") {
	print "[begin] (Blackbox)\n" unless $opt{nomenu};
	blackbox($opt{strip},"");
	print "[end]\n" unless $opt{nomenu};
}
elsif($o_output eq "enlightenment") {
	enlightenment($opt{strip},"index","Enlightenment");
}
elsif($o_output eq "fbpanel") {
	fbpanel($opt{strip},"");
}
elsif($o_output eq "fluxbox") {	# This is the same as blackbox (I hope so)
	print "[begin] (Fluxbox)\n" unless $opt{nomenu};
	blackbox($opt{strip});
	print "[end]\n" unless $opt{nomenu};
}
elsif($o_output eq "fvwm") {
	fvwm($opt{strip},"", "fvwm");
}
elsif($o_output eq "fvwm2") {
	fvwm2($opt{strip},"fvwm2");
}
elsif($o_output eq "icewm") {
	icewm($opt{strip},"");
}
elsif($o_output eq "metisse") {
	metisse($opt{strip},"", "metisse");
}
elsif($o_output eq "olvwm") {
	olvwm($opt{strip},"");
}
elsif($o_output eq "openbox") {
	print "<openbox_menu>\n" unless $opt{nomenu};
	print qq(<menu id="root-menu" label="PLD Linux">\n) unless $opt{nomenu};
	openbox($opt{strip},"");
	print "</menu>\n" unless $opt{nomenu};
	print "</openbox_menu>\n" unless $opt{nomenu};
}
elsif($o_output eq "qvwm") {
	print "[StartMenu]\n";
	qvwm($opt{strip},"");
}
elsif($o_output eq "wmaker") {
	if($opt{strip}) {
		wmaker(1,",","");
	} else {
		wmaker(0,"","");
	}
	print "\n";
}
elsif($o_output eq "wmaker-old") {
	wmakerold($opt{strip},"");
}
elsif($o_output eq "wmii") {
	system(qw(wmiir remove /menu/items/menu));
	wmii($opt{strip}, "");
}
elsif($o_output eq "xfce4") {
	print "<xfdesktop-menu>\n";
	print qq(<title name="Desktop Menu" visible="yes"/>\n) unless $opt{nomenu};
	xfce4($opt{strip},step);
	print "</xfdesktop-menu>\n";
}
elsif($o_output eq "xpde") {
	xpde($opt{strip},$opt{destdir});
}
# WM case }}}
if ( @scale ) {
	warn "Scaling $#scale icons\n";
	my $fork = fork;
	unless ( defined $fork ) {
		warn "Fork failed, scaling in foreground\n";
		$fork = 0;
	}
	if ( $fork == 0) {
		foreach my $cmd (@scale) {
			system($cmd);
		}
	}
}

# vi: ts=4 sw=4 noet fdm=marker
