diff options
Diffstat (limited to 'trunk/menu/xdg_menu')
| -rwxr-xr-x | trunk/menu/xdg_menu | 2216 |
1 files changed, 0 insertions, 2216 deletions
diff --git a/trunk/menu/xdg_menu b/trunk/menu/xdg_menu deleted file mode 100755 index 453753c..0000000 --- a/trunk/menu/xdg_menu +++ /dev/null @@ -1,2216 +0,0 @@ -#!/usr/bin/perl - -# Copyright (c) 2003 SuSE Linux AG, Nuernberg, Germany. All rights reserved. -# -# Author: nadvornik@suse.cz -# -# - -use strict; -use Locale::gettext; -use Getopt::Long; -use Encode; -use I18N::Langinfo qw(langinfo CODESET); -use POSIX qw(locale_h); - -my $Version = "0.2"; - -my $DefaultAppDirs; -my $DefaultDirectoryDirs; -my @KDELegacyDirs; - -my $format = 'WindowMaker'; -my $desktop_name; -my $language = ''; -my $charset = 'iso-8859-1'; -my $root_cmd = 'xdg_menu_su'; - -my $die_on_error = 0; -my $verbose = 0; -my $fullmenu = 0; - -my @language_keys; - -my @accessed_files; -my @save_ARGV = @ARGV; - - -my %Desktop_entries; -my %Directory_entries; - -sub check_file ($) -{ - my ($file) =@_; - - unless (-e $file) { - push @accessed_files, "X $file"; - return ''; - } - - if (-d $file) { - push @accessed_files, "D $file"; - return 'D'; - } else { - push @accessed_files, "F $file"; - return 'F'; - } -} - -sub add_png_extension_if_needed ($) -{ - my ($f) = @_; - return $f =~ /\.(png|xpm|svg)$/ ? $f : "$f.png"; -} - -sub scan_AppDir ($$;$) -{ - my ($pool, $dir, $topdir) = @_; - - check_file($dir); - $topdir = $dir unless defined $topdir; - - opendir(DIR, $dir) or return; - - foreach my $entry (readdir(DIR)) { - - if ( -f "$dir/$entry" && $entry =~ /\.desktop$/ ) { - read_desktop_entry($pool, "$dir/$entry", $topdir); - } - elsif ( -d "$dir/$entry" && $entry ne '.' && $entry ne '..' && $entry ne '.hidden') { - scan_AppDir ($pool, "$dir/$entry", $topdir); - } - } - closedir DIR; -} - -sub scan_DirectoryDir ($$;$) -{ - my ($pool, $dir, $topdir) = @_; - - check_file($dir); - $topdir = $dir unless defined $topdir; - - opendir(DIR, $dir) or return; - - foreach my $entry (readdir(DIR)) { - - if ( -f "$dir/$entry" && $entry =~ /\.directory$/ ) { - read_directory_entry($pool, "$dir/$entry", $topdir); - } - elsif ( -d "$dir/$entry" && $entry ne '.' && $entry ne '..' && $entry ne '.hidden') { - scan_DirectoryDir ($pool, "$dir/$entry", $topdir); - } - } - - closedir DIR; -} - -sub read_directory_entry -{ - my ($pool, $file, $topdir) = @_; - - - unless (defined $Directory_entries{$file}) { - - check_file($file); - - open(FILE, "<$file") or return; - - my $in_desktop_entry = 0; - my %entry; - while (<FILE>) { - if (/^\[/) { - if (/^\[Desktop Entry\]/) { - $in_desktop_entry = 1; - } - elsif (/^\[.*\]/) { - $in_desktop_entry = 0; - } - } - elsif ($in_desktop_entry && /^([^=]*)=([^[:cntrl:]]*)/) { - $entry{$1} = $2; - } - } - close(FILE); - - my $id = $file; - $id =~ s/^$topdir//; - $id =~ s/^\/*//; - $id =~ s/\//-/g; - $entry{'id'} = $id; - - $Directory_entries{$file} = \%entry; - } - - my $entry = $Directory_entries{$file}; - - $pool->{'Directory_entries'}{$entry->{'id'}} = $entry; -} - -sub check_show_in ($) -{ - my ($entry) = @_; - - return 1 unless defined $entry; - - my %OnlyShowIn; - my %NotShowIn; - - if (defined $entry->{'OnlyShowIn'}) { - foreach my $showin (split /;/, $entry->{'OnlyShowIn'}) { - $OnlyShowIn{$showin} = 1; - } - return 0 unless defined $OnlyShowIn{$desktop_name}; - } - if (defined $entry->{'NotShowIn'}) { - foreach my $showin (split /;/, $entry->{'NotShowIn'}) { - $NotShowIn{$showin} = 1; - } - return 0 if defined $NotShowIn{$desktop_name} ; - } - - return 1; -} - -sub read_desktop_entry -{ - my ($pool, $file, $topdir) = @_; - - - unless (defined $Desktop_entries{$file}) { - - check_file($file); - - open(FILE, "<$file") or return; - - my $in_desktop_entry = 0; - my %entry; - while (<FILE>) { - if (/^\[/) { - if (/^\[Desktop Entry\]/) { - $in_desktop_entry = 1; - } - elsif (/^\[.*\]/) { - $in_desktop_entry = 0; - } - } - elsif ($in_desktop_entry && /^([^=]*)=([^[:cntrl:]]*)/) { - $entry{$1} = $2; - } - } - close(FILE); - - my $id = $file; - $id =~ s/^$topdir//; - $id =~ s/^\/*//; - $id =~ s/\//-/g; - $entry{'id'} = $id; - - $entry{'refcount'} = 0; - - $Desktop_entries{$file} = \%entry; - } - - my $entry = $Desktop_entries{$file}; - - return unless defined $entry->{'Name'}; - return unless defined $entry->{'Exec'}; - return if $entry->{'Hidden'} eq 'true'; - return if $entry->{'NoDisplay'} eq 'true'; - - return unless check_show_in($entry); - - return if defined $entry->{'NotShowIn'} && $entry->{'NotShowIn'} eq $desktop_name; - - - if (defined $pool) { - - foreach my $category (split /;/, $entry->{'Categories'}) { - $pool->{'Categories'}{$category} = [] unless defined $pool->{'Categories'}{$category}; - push @{$pool->{'Categories'}{$category}}, $entry; - } - - $pool->{'Desktop_entries'}{$entry->{'id'}} = $entry; - } - - return $entry; -} - -my $cached_pool; - -sub read_desktop_entries ($$) -{ - my ($directory_paths, $desktop_paths) = @_; - - if ($cached_pool->{'Directory_paths'} eq $directory_paths && - $cached_pool->{'Desktop_paths'} eq $desktop_paths) { - - return $cached_pool; - } - - - my $pool = {'Desktop_entries' => {}, - 'Categories' => {}, - 'Directory_entries' => {}, - 'Directory_paths' => $directory_paths, - 'Desktop_paths' => $desktop_paths - }; - - foreach my $dir (split /:/, $directory_paths) { - next if $dir =~ /^\s*$/; - scan_DirectoryDir($pool, $dir); - } - - foreach my $dir (split /:/, $desktop_paths) { - next if $dir =~ /^\s*$/; - scan_AppDir($pool, $dir); - } - - $cached_pool = $pool; - - return $pool; -} - -sub dump_entry_list ($) -{ - my ($list) = @_; - - print "list: "; - foreach my $entry (@$list) { - print "$entry->{id} "; - } - print "\n"; - -} - -sub get_directory_entry ($$) -{ - my ($entry, $pool) = @_; - - return $pool->{'Directory_entries'}{$entry}; -} - -sub interpret_Include -{ - my ($tree, $entries, $pool) = @_; - my %exist; - - my $i = 0; - - - my @list = interpret_entry_node($tree, 'Or', $pool); - - foreach my $e (@$entries) { - if ($e->{type} eq 'desktop') { - $exist{$e->{desktop}} = 1; - } - } - - -# dump_entry_list(\@list); - - foreach my $entry (@list) { - - next if $exist{$entry}; - - push @$entries, {type => 'desktop', desktop => $entry}; - $entry->{'refcount'}++; - - $exist{$entry} = 1; - - } -} - -sub interpret_Exclude -{ - my ($tree, $entries, $pool) = @_; - - my $i = 0; - - my @list = interpret_entry_node($tree, 'Or', $pool); - - - foreach my $entry (@list) { - - my $i = 0; - while (defined $entries->[$i]) { - my $exist = $entries->[$i]; - if ($exist->{type} eq 'desktop' && - $exist->{desktop} eq $entry) { - splice @$entries, $i, 1; - $entry->{'refcount'}--; - } - else { - $i++; - } - } - } -} - - -sub interpret_entry_node ($$$) -{ - my ($tree, $node, $pool) = @_; - - my $i = 0; - $i++ if (ref($tree->[$i]) eq 'HASH'); - - my @subtree; - - while (defined $tree->[$i]) { - if ($tree->[$i] eq 'Filename') { - $i++; - if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') { - my $entry = $tree->[$i][2]; - if (defined $pool->{'Desktop_entries'}{$entry}) { - push @subtree, [$pool->{'Desktop_entries'}{$entry}]; - } - else { - push @subtree, []; - } - } - else { - print STDERR "Filename\n"; - exit 1 if $die_on_error; - } - $i++; - } - elsif ($tree->[$i] eq 'Category') { - $i++; - if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') { - my $category = $tree->[$i][2]; - if (defined $pool->{'Categories'}{$category}) { - push @subtree, $pool->{'Categories'}{$category}; - } - else { - push @subtree, []; - } - } - else { - print STDERR "Category\n"; - exit 1 if $die_on_error; - } - $i++; - } - elsif ($tree->[$i] eq 'All') { - $i++; - if (values %{$pool->{'Desktop_entries'}} > 0) { - push @subtree, [values %{$pool->{'Desktop_entries'}}]; - } - else { - push @subtree, []; - } - $i++; - } - elsif ($tree->[$i] eq '0') { - $i++; - $i++; - } - else { - my @res = interpret_entry_node($tree->[$i+1], $tree->[$i], $pool); - push @subtree, \@res; - $i++; $i++; - } - } - - if ($node eq 'Or') - { -# print "or - \n"; - - my %used; - my @res; - foreach my $st (@subtree) { -# print " st: "; -# dump_entry_list($st); - foreach my $entry (@$st) { - if (! defined $used{$entry}) { - push @res, $entry; - $used{$entry} = 1; - } - } - } -# print " res: "; -# dump_entry_list(\@res); - return @res; - } elsif ($node eq 'And') - { - my %used; - my @res; -# print "and - \n"; - my $cnt = @subtree; - my $min = @{$subtree[0]}; - my $min_idx = 0; - my $idx = 0; - - foreach my $st (@subtree) { -# print " st: "; -# dump_entry_list($st); - - my $num = @$st; - if ($num < $min) { - $min = $num; - $min_idx = $idx; - } - - my %dupes; - foreach my $entry (@$st) { - next if $dupes{$entry}; - $dupes{$entry} = 1; - - if (! defined $used{$entry}) { - $used{$entry} = 1; - } - else { - $used{$entry} ++ - } - } - - $idx ++; - } - return () if $cnt == 0; - foreach my $entry (@{$subtree[$min_idx]}) { - push @res, $entry if $used{$entry} == $cnt; - } - -# print " res: "; -# dump_entry_list(\@res); - return @res; - } elsif ($node eq 'Not') - { - my %used; - my @res; -# print "not - \n"; - my $cnt = @subtree; - foreach my $st (@subtree) { -# print " st: "; -# dump_entry_list($st); - foreach my $entry (@$st) { - $used{$entry} = 1; - } - } - return if $cnt == 0; - foreach my $entry (values %{$pool->{'Desktop_entries'}}) { - push @res, $entry if !defined $used{$entry}; - } - -# print " res: "; -# dump_entry_list(\@res); - return @res; - } else { - print STDERR "Can't use '$node' inside <Include> or <Exclude>\n"; - exit 1 if $die_on_error; - return (); - } -} - -sub interpret_root ($$) -{ - my ($tree, $topdir) = @_; - if ($tree->[0] eq 'Menu') { - return interpret_menu($tree->[1]); - } - else { - print STDERR "No toplevel Menu\n"; - exit 1 if $die_on_error; - return; - } -} - - -sub interpret_menu ($;$$) -{ - my ($tree, $directory_paths, $desktop_paths) = @_; - - $directory_paths = '' unless defined $directory_paths; - $desktop_paths = '' unless defined $desktop_paths; - - my %menu = ('entries' => [], - 'OnlyUnallocated' => 0, - 'DontShowIfEmpty' => 0, - 'Deleted' => 0); - - my $i = 0; - - $i++ if (ref($tree->[$i]) eq 'HASH'); - - while (defined $tree->[$i]) { - if ($tree->[$i] eq 'AppDir') { - if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') { - $desktop_paths .= ':' . $tree->[$i + 1][2]; - splice @$tree, $i, 2; - } - else { - print STDERR "wrong AppDir\n"; - exit 1 if $die_on_error; - $i++; - $i++; - } - } - elsif ($tree->[$i] eq 'DefaultAppDirs') { - $desktop_paths .= ':' . $DefaultAppDirs; - splice @$tree, $i, 2; - } - elsif ($tree->[$i] eq 'DirectoryDir') { - if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') { - $directory_paths .= ':' . $tree->[$i + 1][2]; - splice @$tree, $i, 2; - } - else { - print STDERR "wrong DirectoryDir\n"; - exit 1 if $die_on_error; - $i++; - $i++; - } - } - elsif ($tree->[$i] eq 'DefaultDirectoryDirs') { - $directory_paths .= ':' . $DefaultDirectoryDirs; - splice @$tree, $i, 2; - } - else { - $i++; - $i++; - } - } - - - $menu{directory_paths} = $directory_paths; - $menu{desktop_paths} = $desktop_paths; - - my $pool = read_desktop_entries($directory_paths, $desktop_paths); - - - $i = 0; - - $i++ if (ref($tree->[$i]) eq 'HASH'); - - while (defined $tree->[$i]) { - if ($tree->[$i] eq 'Menu') { - $i++; - my $submenu = interpret_menu($tree->[$i], $directory_paths, $desktop_paths); - push @{$menu{'entries'}}, {type => 'menu', menu => $submenu}; - $i++; - } - elsif ($tree->[$i] eq 'Name') { - $i++; - if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') { - $menu{'Name'} = $tree->[$i][2]; - } - else { - print STDERR "wrong Name\n"; - exit 1 if $die_on_error; - } - $i++; - } - elsif ($tree->[$i] eq 'Directory') { - $i++; - if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') { - $menu{'Directory'} = get_directory_entry($tree->[$i][2], $pool); -# print "Directory " . $tree->[$i][2] . "\n"; - } - else { - print STDERR "wrong Directory\n"; - exit 1 if $die_on_error; - } - $i++; - } - elsif ($tree->[$i] eq 'OnlyUnallocated') { - $menu{'OnlyUnallocated'} = 1; - $i++; - $i++; - } - elsif ($tree->[$i] eq 'DontShowIfEmpty') { - $menu{'DontShowIfEmpty'} = 1; - $i++; - $i++; - } - elsif ($tree->[$i] eq 'Deleted') { - $menu{'Deleted'} = 1; - $i++; - $i++; - } - elsif ($tree->[$i] eq 'NotDeleted') { - $menu{'Deleted'} = 0; - $i++; - $i++; - } - elsif ($tree->[$i] eq 'Include') { - $i++; - interpret_Include($tree->[$i], $menu{'entries'}, $pool); - $i++; - } - elsif ($tree->[$i] eq 'Exclude') { - $i++; - interpret_Exclude($tree->[$i], $menu{'entries'}, $pool); - $i++; - } - elsif ($tree->[$i] eq '0') { - $i++; - if ($tree->[$i] !~ /^\s*$/) { - print STDERR "skip '$tree->[$i]'\n" ; - exit 1 if $die_on_error; - } - $i++; - } - else { - print STDERR "Unknown '$tree->[$i]':\n"; - $i++; - print STDERR " '@{$tree->[$i]}'\n"; - $i++; - exit 1 if $die_on_error; - } - } - - return \%menu; -} - - -sub read_menu ($;$) -{ - my ($file, $basedir) = @_; - - - if ($file !~ /^\// && defined $basedir) { - $file = "$basedir/$file"; - } - - unless (defined $basedir) { - $basedir = $file; - $basedir =~ s/\/[^\/]*$//; - } - - unless (check_file($file)) { - print STDERR "WARNING: '$file' does not exist\n"; - return ['Menu', [{}]]; - } - - print STDERR "reading '$file'\n" if $verbose; - - my $parser = new XML::Parser(Style => 'Tree'); - my $tree = $parser->parsefile($file); - - my $DefaultMergeDir = $file; - $DefaultMergeDir =~ s/^.*\///; - $DefaultMergeDir =~ s/\.menu$/-merged/; - - read_includes($tree, $basedir, $DefaultMergeDir); - - return $tree -} - -sub read_menu_dir ($;$) -{ - my ($dir, $basedir) = @_; - - my @out; - - if ($dir !~ /^\// && defined $basedir) { - $dir = "$basedir/$dir"; - } - - - check_file($dir); - - opendir(DIR, $dir); - - foreach my $entry (readdir(DIR)) { - - if ( -f "$dir/$entry" && $entry =~ /\.menu$/ ) { - my $menu = read_menu("$dir/$entry"); - $menu = remove_toplevel_Menu($menu); - push @out, @$menu; - } - } - closedir DIR; - - return \@out; -} - -sub quote_xml ($) -{ - my ($txt) = @_; - - $txt =~ s/&/&/g; - $txt =~ s/</</g; - $txt =~ s/>/>/g; - return $txt; -} - -sub read_legacy_dir ($;$) -{ - my ($dir,$basedir) = @_; - my $out; - - $dir =~ s/\/*$//; - - $basedir = $dir unless defined $basedir; - - return "" if check_file($dir) ne 'D'; - - $out = "<Menu>\n"; - - if ($dir eq $basedir) { - my $xmldir = quote_xml($dir); - - $out .= "<AppDir>$xmldir</AppDir>\n"; - $out .= "<DirectoryDir>$xmldir</DirectoryDir>\n"; - } - else { - my $name = $dir; - $name =~ s/\/*$//; - $name =~ s/^.*\///; - - $name = quote_xml($name); - - $out .= "<Name>$name</Name>\n"; - } - - - if (-f "$dir/.directory") { - - my $dir_id = "$dir/.directory"; - $dir_id =~ s/^$basedir//; - $dir_id =~ s/^\///; - $dir_id = quote_xml($dir_id); - - $out .= "<Directory>$dir_id</Directory>\n"; - } - - opendir(DIR, $dir); - - foreach my $entry (readdir(DIR)) { - - if ( -f "$dir/$entry" && $entry =~ /\.desktop$/ ) { - my $id = "$dir/$entry"; - $id =~ s/^$basedir//; - $id =~ s/^\///; - $id =~ s/\//-/g; - $id = quote_xml($id); - - my $desktop = read_desktop_entry(undef, "$dir/$entry", $basedir); - $out .= "<Include><Filename>$id</Filename></Include>\n" unless defined $desktop->{'Categories'} - } - elsif ( -d "$dir/$entry" && $entry ne '.' && $entry ne '..' && $entry ne '.hidden') { - $out .= read_legacy_dir("$dir/$entry", $basedir); - } - } - closedir DIR; - $out .= "</Menu>\n"; - return $out; -} - -sub remove_toplevel_Menu ($) -{ - my ($tree) = @_; - if ($tree->[0] eq 'Menu') { - shift @{$tree->[1]} if (ref($tree->[1][0]) eq 'HASH'); - return $tree->[1]; - } - else { - print STDERR "No toplevel Menu\n"; - exit 1 if $die_on_error; - return; - } -} - -sub read_includes ($$$) -{ - my ($tree, $basedir, $DefaultMergeDir) = @_; - - my $i = 0; - - $i++ if (ref($tree->[$i]) eq 'HASH'); - - while (defined $tree->[$i]) { - if ($tree->[$i] eq 'MergeFile') { - if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') { - my $add_tree = read_menu($tree->[$i + 1][2], $basedir); - $add_tree = remove_toplevel_Menu($add_tree); - - splice @$tree, $i, 2, @$add_tree; - - } - else { - print STDERR "wrong MergeFile\n"; - exit 1 if $die_on_error; - $i++; - $i++; - } - - } - elsif ($tree->[$i] eq 'MergeDir') { - if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') { - - my $add_tree = read_menu_dir($tree->[$i + 1][2], $basedir); - - splice @$tree, $i, 2, @$add_tree; - - } - else { - print STDERR "wrong MergeFile\n"; - exit 1 if $die_on_error; - $i++; - $i++; - } - - } - elsif ($tree->[$i] eq 'DefaultMergeDirs') { - my $add_tree = read_menu_dir($DefaultMergeDir, $basedir); - splice @$tree, $i, 2, @$add_tree; - } - elsif ($tree->[$i] eq 'LegacyDir') { - if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') { - - my $xml = read_legacy_dir($tree->[$i + 1][2]); - print STDERR "reading legacy directory '" . $tree->[$i + 1][2] . "'\n" if $verbose; - - my $parser = new XML::Parser(Style => 'Tree'); - my $add_tree = $parser->parse($xml); - $add_tree = remove_toplevel_Menu($add_tree); - splice @$tree, $i, 2, @$add_tree; - - } - else { - print STDERR "wrong LegacyDir\n"; - exit 1 if $die_on_error; - $i++; - $i++; - } - - } - elsif ($tree->[$i] eq 'KDELegacyDirs') { - my @out; - foreach my $dir (@KDELegacyDirs) { - my $xml = read_legacy_dir($dir); - print STDERR "reading legacy directory '$dir'\n" if $verbose; - - my $parser = new XML::Parser(Style => 'Tree'); - my $add_tree = $parser->parse($xml); - $add_tree = remove_toplevel_Menu($add_tree); - push @out, @$add_tree - } - splice @$tree, $i, 2, @out; - } - elsif ($tree->[$i] eq 'Menu') { - $i++; - read_includes($tree->[$i], $basedir, $DefaultMergeDir); - $i++; - } - else { - $i++; - $i++; - } - } -} - -sub get_menu_name ($) -{ - my ($tree) = @_; - my $name; - - my $i = 0; - - $i++ if (ref($tree->[$i]) eq 'HASH'); - - while (defined $tree->[$i]) { - if ($tree->[$i] eq 'Name') { - $i++; - if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') { - $name = $tree->[$i][2]; - last; - } - else { - print STDERR "wrong Name\n"; - } - $i++; - } - else { - $i++; - $i++; - } - } - - unless (defined $name) { - print STDERR "Menu has no name element\n"; - } - return $name; -} - - -sub append_menu ($$) -{ - my ($target, $source) = @_; - - my $i = 0; - - $i++ if (ref($source->[$i]) eq 'HASH'); - - while (defined $source->[$i]) { - if ($source->[$i] ne 'Name') { - push @$target, $source->[$i]; - push @$target, $source->[$i + 1]; - } - - $i++; - $i++; - } -} - - -sub merge_menus ($) -{ - my ($tree) = @_; - - my %used; #menu name already used - - my $i = 0; - - $i++ if (ref($tree->[$i]) eq 'HASH'); - - while (defined $tree->[$i]) { - if ($tree->[$i] eq 'Menu') { - my $name = get_menu_name($tree->[$i + 1]); - if (defined $used{$name}) { #second menu with the same name - my $target = $used{$name}; - - append_menu($tree->[$target], $tree->[$i + 1]); - - splice @$tree, $i, 2; - } - else { # first appearance - $used{$name} = $i + 1; - $i++; - $i++; - } - } - else { - $i++; - $i++; - } - } - - - $i = 0; - $i++ if (ref($tree->[$i]) eq 'HASH'); - - while (defined $tree->[$i]) { - if ($tree->[$i] eq 'Menu') { - merge_menus($tree->[$i + 1]); - } - $i++; - $i++; - } -} - -sub read_Move ($$) -{ - my ($tree, $hash) = @_; - - my $i = 0; - - my $old = ''; - - - $i++ if (ref($tree->[$i]) eq 'HASH'); - - while (defined $tree->[$i]) { - if ($tree->[$i] eq 'Old') { - $i++; - if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') { - $old = $tree->[$i][2]; - } - else { - print STDERR "wrong Old\n"; - exit 1 if $die_on_error; - } - $i++; - } - if ($tree->[$i] eq 'New') { - $i++; - if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') { - $hash->{$old} = $tree->[$i][2]; - } - else { - print STDERR "wrong New\n"; - exit 1 if $die_on_error; - } - $i++; - } - else { - $i++; - $i++; - } - } -} - -sub find_menu_in_tree ($$) -{ - my ($path, $tree) = @_; - - my $root = $path; - $root =~ s/\/.*$//; - - my $subpath = $path; - $subpath =~ s/^[^\/]*\/*//; - - my $i = 0; - - $i++ if (ref($tree->[$i]) eq 'HASH'); - - while (defined $tree->[$i]) { - if ($tree->[$i] eq 'Menu') { - if ($root eq get_menu_name($tree->[$i + 1])) { - - if ($subpath eq '') { - return { 'parent' => $tree, 'index' => $i, 'menu' => $tree->[$i + 1]}; - } - return find_menu_in_tree($subpath, $tree->[$i + 1]); - } - } - - $i++; - $i++; - } - - return undef; -} - -sub copy_menu ($$) -{ - my ($path, $tree) = @_; - - my $tail; - my $child; - - foreach my $elem (reverse split(/\//, $path)) { - next if $elem eq ''; - - my $menu = [{}, 'Name', [{}, 0, $elem]]; - push @$menu, ('Menu', $child) if defined $child; - - $tail = $menu unless defined $tail; - $child = $menu; - } - - append_menu($tail, $tree); - - return $child; -} - -sub move_menus ($) -{ - my ($tree) = @_; - -# print "@$tree\n"; - my %move; - - my $i = 0; - - $i++ if (ref($tree->[$i]) eq 'HASH'); - - while (defined $tree->[$i]) { - if ($tree->[$i] eq 'Move') { - - read_Move($tree->[$i + 1], \%move); - splice @$tree, $i, 2; - } - else { - $i++; - $i++; - } - } - - foreach my $source (keys %move) { - my $sourceinfo = find_menu_in_tree($source, $tree); - - if (defined $sourceinfo) { - my $target = copy_menu($move{$source}, $sourceinfo->{'menu'}); - splice @{$sourceinfo->{'parent'}}, $sourceinfo->{'index'}, 2; - push @$tree, ('Menu', $target); - merge_menus($tree); - } - } - - $i = 0; - $i++ if (ref($tree->[$i]) eq 'HASH'); - - while (defined $tree->[$i]) { - if ($tree->[$i] eq 'Menu') { - move_menus($tree->[$i + 1]); - } - $i++; - $i++; - } -} - -sub remove_allocated ($) -{ - my ($menu) = @_; - - - my $i = 0; - while ($i < @{$menu->{'entries'}}) { - my $entry = $menu->{'entries'}[$i]; - - if ($entry->{type} eq 'menu') { - remove_allocated($entry->{menu}); - $i++; - } - elsif ($entry->{type} eq 'desktop' && - $menu->{'OnlyUnallocated'} && - $entry->{desktop}{'refcount'} > 1) { - - $entry->{desktop}{'refcount'}--; - splice @{$menu->{'entries'}}, $i, 1; - } - else { - $i++; - } - - - } - return 0; -} - - -sub remove_empty_menus ($) -{ - my ($menu) = @_; - - - my $i = 0; - while ($i < @{$menu->{'entries'}}) { - my $entry = $menu->{'entries'}[$i]; - - if ($entry->{type} eq 'menu' && remove_empty_menus($entry->{menu})) { - splice @{$menu->{'entries'}}, $i, 1; - } - else { - $i++; - } - - - } - - return 1 if @{$menu->{'entries'}} == 0; # && $menu->{'DontShowIfEmpty'}; #menu is empty - - return 0; -} - - -sub prepare_exec ($$) -{ - my ($exec, $desktop) = @_; - - $exec =~ s/%f//g; - $exec =~ s/%F//g; - $exec =~ s/%u//g; - $exec =~ s/%U//g; - $exec =~ s/%d//g; - $exec =~ s/%D//g; - $exec =~ s/%n//g; - $exec =~ s/%N//g; - $exec =~ s/%i//g; - $exec =~ s/%k//g; - $exec =~ s/%v//g; - $exec =~ s/%m//g; - - my $caption = $desktop->{Name}; - - $exec =~ s/%c/$caption/g; - - $exec =~ s/%%/%/g; - - $exec = "xterm -e $exec" if $desktop->{Terminal} eq '1' || $desktop->{Terminal} eq 'true'; - - $exec = "$root_cmd $exec" if $desktop->{'X-KDE-SubstituteUID'} eq '1' || $desktop->{'X-KDE-SubstituteUID'} eq 'true'; - return $exec; -} - -sub get_loc_entry ($$) -{ - my ($desktop, $entry) = @_; - - foreach my $key (@language_keys) { - my $loc_entry = $entry . "[$key]"; - return $desktop->{$loc_entry} if defined $desktop->{$loc_entry} && $desktop->{$loc_entry} !~ /^\s*$/; - } - - return $desktop->{$entry}; -} - -sub preprocess_menu ($) -{ - # localize, sort, prepare_exec - my ($menu) = @_; - - return 0 if $menu->{'Deleted'}; - return 0 unless check_show_in($menu->{'Directory'}); - return 0 if defined $menu->{'Directory'} && $menu->{'Directory'}->{'NoDisplay'} eq 'true'; - - my $menu_name = $menu->{'Name'}; - my $menu_icon = ""; - - if (defined $menu->{'Directory'}) { - my $directory = $menu->{'Directory'}; - $menu_icon = $menu->{'Directory'}{'Icon'}; - my $directory_name = get_loc_entry($directory, 'Name'); - - if (defined $directory_name) { - Encode::from_to($directory_name, "utf8", $charset) - if !defined $directory->{"Encoding"} || $directory->{"Encoding"} eq 'UTF-8'; - - $menu_name = $directory_name; - } - } - - $menu->{'PrepName'} = $menu_name; - $menu->{'PrepIcon'} = $menu_icon; - - my $i = 0; - while (defined $menu->{'entries'}[$i]) { - my $entry = $menu->{'entries'}[$i]; - if ($entry->{'type'} eq 'desktop') { - my $desktop = $entry->{desktop}; - - my $name = $desktop->{'id'}; - - my $desktop_name = get_loc_entry($desktop, 'Name'); - - if (defined $desktop_name) { - Encode::from_to($desktop_name, "utf8", $charset) - if !defined $desktop->{"Encoding"} || $desktop->{"Encoding"} eq 'UTF-8'; - - $name = $desktop_name; - } - - $desktop->{'PrepName'} = $name; - $entry->{'Name'} = $name; - $entry->{'PrepName'} = $name; - - $desktop->{'PrepExec'} = prepare_exec($desktop->{Exec}, $desktop); - $i++; - } - elsif ($entry->{type} eq 'menu') { - if (preprocess_menu ($entry->{'menu'})) { - $entry->{'Name'} = $entry->{'menu'}{'Name'}; - $entry->{'PrepName'} = $entry->{'menu'}{'PrepName'}; - $i++; - } - else { - splice @{$menu->{'entries'}}, $i, 1; - } - } - else { - print STDERR "wrong menu entry type: $entry->{type}"; - exit 1 if $die_on_error; - splice @{$menu->{'entries'}}, $i, 1; - } - } - - $menu->{'entries'} = [ sort {$b->{'type'} cmp $a->{'type'} || $a->{'PrepName'} cmp $b->{'PrepName'}} @{$menu->{'entries'}} ]; - - my $i = 0; - my $prev_entry; - while (defined $menu->{'entries'}[$i]) { - my $entry = $menu->{'entries'}[$i]; - if (defined $prev_entry && - $entry->{'type'} eq 'desktop' && - $prev_entry->{'type'} eq 'desktop' && - $prev_entry->{'PrepName'} eq $entry->{'PrepName'} && - $prev_entry->{'desktop'}->{'PrepExec'} eq $entry->{'desktop'}->{'PrepExec'}) { - splice @{$menu->{'entries'}}, $i, 1; - } - else { - $prev_entry = $entry; - $i++; - } - } - - return 1; -} - -sub output_twm_menu ($;$$) -{ - my ($menu, $toplevel, $path) = @_; - - my $output = ''; - - $path = '' unless defined $path; - - $toplevel = 1 unless defined $toplevel; - - my $menu_name = $menu->{'PrepName'}; - my $menu_id = "$path-" . $menu->{'Name'}; - $menu_id =~ s/\s/_/g; - - $menu_id = 'xdg_menu' if $toplevel; - - foreach my $entry (@{$menu->{'entries'}}) { - if ($entry->{type} eq 'menu') { - $output .= output_twm_menu($entry->{'menu'}, 0, $menu_id); - } - } - - $output .= "menu \"$menu_id\" {\n"; - $output .= "\"$menu_name\" f.title\n"; - - foreach my $entry (@{$menu->{'entries'}}) { - if ($entry->{type} eq 'desktop') { - my $desktop = $entry->{desktop}; - - my $name = $desktop->{'PrepName'}; - my $exec = $desktop->{'PrepExec'}; - my $color = ''; - - $exec =~ s/"/\\"/g; - - $color = ' ("red":"grey")' if $desktop->{'X-KDE-SubstituteUID'} eq '1' || $desktop->{'X-KDE-SubstituteUID'} eq 'true'; - - $output .= "\"$name\"$color f.exec \"$exec&\"\n"; - } - elsif ($entry->{type} eq 'menu') { - my $name = $entry->{'menu'}{'PrepName'}; - my $id = "$menu_id-" . $entry->{'menu'}{'Name'}; - - $id =~ s/\s/_/g; - - $output .= "\"$name\" f.menu \"$id\"\n"; - } - else { - print STDERR "wrong menu entry type: $entry->{type}"; - } - - } - $output .= "}\n"; - - return $output; -} - -sub output_wmaker_menu ($;$) -{ - my ($menu, $indent) = @_; - - my $output = ''; - - $indent = 0 unless defined $indent; - - my $menu_name = $menu->{'PrepName'}; - - $output .= ' ' x $indent; - $output .= "\"$menu_name\" MENU\n"; - - if ($indent == 0) { - $output .= "\n#include \"user.menu\"\n\n"; - } - - - foreach my $entry (@{$menu->{'entries'}}) { - if ($entry->{type} eq 'desktop') { - my $desktop = $entry->{desktop}; - - my $name = $desktop->{'PrepName'}; - my $exec = $desktop->{'PrepExec'}; - - $output .= ' ' x $indent; - $output .= " \"$name\" EXEC $exec\n"; - } - elsif ($entry->{type} eq 'menu') { - $output .= output_wmaker_menu ($entry->{'menu'}, $indent + 1); - } - else { - print STDERR "wrong menu entry type: $entry->{type}"; - } - - } - - if ($indent == 0) { - textdomain("menu-messages"); - - my $exit_msg = gettext("Exit"); - my $restart_msg = gettext("Restart"); - if (langinfo(CODESET) ne 'UTF-8') { - $exit_msg = Encode::encode_utf8($exit_msg); - $restart_msg = Encode::encode_utf8($restart_msg); - } - $output .= "\t\"$exit_msg\" MENU\n\t\t\"$restart_msg\" RESTART\n\t\t\"$exit_msg\" EXIT\n\"$exit_msg\" END\n"; - } - - $output .= ' ' x $indent; - $output .= "\"$menu_name\" END\n"; - - return $output; -} - -sub output_fvwm2_menu ($;$$) -{ - my ($menu, $toplevel, $path) = @_; - - my $output = ''; - - $path = '' unless defined $path; - - $toplevel = 1 unless defined $toplevel; - - my $menu_name = $menu->{'PrepName'}; - my $menu_id = "$path-" . $menu->{'Name'}; - $menu_id =~ s/\s/_/g; - - $menu_id = 'xdg_menu' if $toplevel; - - foreach my $entry (@{$menu->{'entries'}}) { - if ($entry->{type} eq 'menu') { - $output .= output_fvwm2_menu($entry->{'menu'}, 0, $menu_id); - } - } - - $output .= "DestroyMenu \"$menu_id\"\n"; - $output .= "AddToMenu \"$menu_id\" \"$menu_name\" Title\n"; - - foreach my $entry (@{$menu->{'entries'}}) { - if ($entry->{type} eq 'desktop') { - my $desktop = $entry->{desktop}; - - my $name = $desktop->{'PrepName'}; - my $exec = $desktop->{'PrepExec'}; - - $output .= "+ \"$name\" Exec $exec\n"; - } - elsif ($entry->{type} eq 'menu') { - my $name = $entry->{'menu'}{'PrepName'}; - my $id = "$menu_id-" . $entry->{'menu'}{'Name'}; - $id =~ s/\s/_/g; - - $output .= "+ \"$name\" Popup \"$id\"\n"; - } - else { - print STDERR "wrong menu entry type: $entry->{type}"; - } - - } - $output .= "\n"; - - return $output; -} - -sub output_blackbox_menu ($;$) -{ - my ($menu, $indent) = @_; - - my $output = ''; - my $run = $format eq 'fluxbox' ? 'fbrun -nearmouse' : 'bbrun -a -w'; - - $output .= "[begin] (Menu)\n"; - $output .= output_blackbox_inner_menu ($menu, $indent); - $output .= "[separator]\n"; - $output .= '[config] (Configuration) - [workspaces] (Workspace) - [submenu] (System Styles) {Choose a style...} - [stylesdir] (/usr/share/blackbox/styles) - [stylesdir] (/usr/share/fluxbox/styles) - [stylesdir] (/usr/share/openbox/styles) - [end] - [submenu] (User Styles) {Choose a style...} - [stylesdir] (~/.blackbox/styles) - [stylesdir] (~/.fluxbox/styles) - [stylesdir] (~/.openbox/styles) - [end] - [separator] - [exec] (Run Command) {' . $run . '} - [exec] (Lock Screen) {xlock} - [restart] (Restart) {} - [exit] (Logout) -[end] -'; - $output .= "[end]\n"; - return $output; -} - - -sub output_blackbox_inner_menu ($;$) -{ - my ($menu, $indent) = @_; - - my $output = ''; - - $indent = 0 unless defined $indent; - - my $menu_name = $menu->{'PrepName'}; - - $output .= ' ' x $indent; - $output .= "[submenu] ($menu_name)\n"; - - foreach my $entry (@{$menu->{'entries'}}) { - if ($entry->{type} eq 'desktop') { - my $desktop = $entry->{desktop}; - - my $name = $desktop->{'PrepName'}; - my $exec = $desktop->{'PrepExec'}; - - $output .= ' ' x $indent; - $output .= " [exec] ($name) {$exec}\n"; - } - elsif ($entry->{type} eq 'menu') { - $output .= output_blackbox_inner_menu ($entry->{'menu'}, $indent + 1); - } - else { - print STDERR "wrong menu entry type: $entry->{type}"; - } - - } - $output .= ' ' x $indent; - $output .= "[end] # ($menu_name)\n"; - - return $output; -} - -sub output_icewm_menu ($;$) -{ - my ($menu, $indent) = @_; - - my $output = ''; - - $indent = 0 unless defined $indent; - - my $menu_name = $menu->{'PrepName'}; - my $menu_icon = $menu->{'PrepIcon'} || "folder" ; - - $output .= ' ' x $indent; - $output .= "menu \"$menu_name\" $menu_icon.png {\n"; - - foreach my $entry (@{$menu->{'entries'}}) { - if ($entry->{type} eq 'desktop') { - my $desktop = $entry->{desktop}; - - my $name = $desktop->{'PrepName'}; - my $exec = $desktop->{'PrepExec'}; - my $icon = add_png_extension_if_needed($desktop->{'Icon'}); - - $output .= ' ' x $indent; - $output .= " prog \"$name\" $icon $exec\n"; - } - elsif ($entry->{type} eq 'menu') { - $output .= output_icewm_menu ($entry->{'menu'}, $indent + 1); - } - else { - print STDERR "wrong menu entry type: $entry->{type}"; - } - - } - $output .= ' ' x $indent; - $output .= "}\n"; - - return $output; -} - -sub prepare_exec_xfce4 ($$) -{ - my ($exec, $desktop) = @_; - - $exec =~ s/%f//g; - $exec =~ s/%F//g; - $exec =~ s/%u//g; - $exec =~ s/%U//g; - $exec =~ s/%d//g; - $exec =~ s/%D//g; - $exec =~ s/%n//g; - $exec =~ s/%N//g; - $exec =~ s/%i//g; - $exec =~ s/%k//g; - $exec =~ s/%v//g; - $exec =~ s/%m//g; - - my $caption = $desktop->{Name}; - - $exec =~ s/%c/$caption/g; - - $exec =~ s/%%/%/g; - - $exec =~ s/\"/"/g; - - $exec = "$root_cmd $exec" if $desktop->{'X-KDE-SubstituteUID'} eq '1' || $desktop->{'X-KDE-SubstituteUID'} eq 'true'; - return $exec; -} - - - -sub output_xfce4_menu ($;$) -{ - my ($menu, $indent) = @_; - - my $output = ''; - - $indent = 0 unless defined $indent; - - if ($indent == 0) { - $output .= '<?xml version="1.0" encoding="UTF-8"?>' . "\n"; - $output .= '<!DOCTYPE xfdesktop-menu [' . "\n"; - $output .= ' <!ENTITY menu2 SYSTEM "menu2.xml">' . "\n"; - $output .= ']>' . "\n\n"; - } - - my $menu_name = $menu->{'PrepName'}; - my $menu_ico = $menu->{'PrepIcon'}; - $output .= ' ' x $indent; - - if ($indent == 0) { - $output .= "<xfdesktop-menu>\n" - } - else { - $output .= "<menu name=\"" . quote_xml($menu_name) ."\" visible=\"yes\" icon=\"${menu_ico}.png \">\n"; - } - - foreach my $entry (@{$menu->{'entries'}}) { - if ($entry->{type} eq 'desktop') { - my $desktop = $entry->{desktop}; - - my $name = $desktop->{'PrepName'}; - my $exec = prepare_exec_xfce4($desktop->{Exec}, $desktop); - my $term = ($desktop->{Terminal} eq '1' || $desktop->{Terminal} eq 'true') ? "yes" : "no"; - my $ico = $desktop->{'Icon'}; - $output .= ' ' x $indent; - $output .= " <app name=\"" . quote_xml($name) ."\" cmd=\"$exec\" icon=\"$ico\" term=\"$term\"/>\n"; - } - elsif ($entry->{type} eq 'menu') { - $output .= output_xfce4_menu ($entry->{'menu'}, $indent + 1); - } - else { - print STDERR "wrong menu entry type: $entry->{type}"; - } - - } - $output .= ' ' x $indent; - - if ($indent == 0) { - $output .= "</xfdesktop-menu>\n"; - } - else { - $output .= "</menu>\n"; - } - - return $output; -} - -sub output_openbox3_menu ($;$) -{ - my ($menu, $indent) = @_; - - my $output = ''; - - $output .= '<?xml version="1.0" encoding="UTF-8"?> - -<openbox_menu xmlns="http://openbox.org/" - xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" - xsi:schemaLocation="http://openbox.org/ - file:///usr/share/openbox/menu.xsd">'; - $output .= "<menu id=\"xdg\" label=\"xdg\">\n"; - $output .= output_openbox3_inner_menu ($menu, $indent); - $output .= "</menu>\n"; - $output .= ' <menu id="root-menu" label="Openbox 3"> - <item label="xterm"> - <action name="Execute"><execute>xterm</execute></action> </item> - <separator /> - <menu id="KDE Menu" label="KDE Menu" /> - <separator /> - <menu id="client-list-menu" /> - <separator /> - <menu id="ob-menu" label="openbox3"> - <item label="ob conf"><action name="Execute"><execute>obconf</execute></action></item> - <item label="reconfigure"><action name="Reconfigure" /></item> - </menu> - <separator /> - <item label="lock screen"><action name="Execute"><execute>xlock -remote -nice 19 -mode blank -geometry 1x1 -enablesaver</execute></action></item> - <separator /> - <item label="Exit"><action name="Exit" /></item> - </menu>'; - $output .= "</openbox_menu>\n"; - return $output; -} - -sub output_openbox3_pipe_menu ($;$) -{ - my ($menu, $indent) = @_; - - my $output = ''; - - $output .= "<openbox_pipe_menu>\n"; - $output .= output_openbox3_inner_menu ($menu, $indent); - $output .= "</openbox_pipe_menu>\n"; - return $output; -} - -sub output_openbox3_inner_menu ($;$) -{ - my ($menu, $indent) = @_; - - my $output = ''; - - $indent = 0 unless defined $indent; - my $menu_name = $menu->{'PrepName'}; - - $output .= ' ' x $indent; - $output .= "<menu id=\"" . quote_xml($menu_name) . "\" label=\"".quote_xml($menu_name) . "\">\n"; -# $output .= "<menu label=\"".quote_xml($menu_name) . "\">\n"; - - foreach my $entry (@{$menu->{'entries'}}) { - if ($entry->{type} eq 'desktop') { - my $desktop = $entry->{desktop}; - - my $name = $desktop->{'PrepName'}; - my $exec = $desktop->{'PrepExec'}; - - $output .= ' ' x $indent; - $output .= " <item label=\"". quote_xml($name)."\">\n"; - $output .= " <action name=\"Execute\"><execute>$exec</execute></action>\n"; - $output .= " </item>\n"; - } - elsif ($entry->{type} eq 'menu') { - $output .= output_openbox3_inner_menu ($entry->{'menu'}, $indent + 1); - } - else { - print STDERR "wrong menu entry type: $entry->{type}"; - } - - } - $output .= ' ' x $indent; - $output .= "</menu> <!-- $menu_name -->\n"; - - return $output; -} - - -sub output_readable ($;$) -{ - my ($menu, $indent) = @_; - - my $output = ''; - - $indent = 0 unless defined $indent; - - my $menu_name = $menu->{'Name'}; - - $output .= "\t" x $indent; - $output .= "\"$menu_name\" MENU\n"; - - - foreach my $entry (@{$menu->{'entries'}}) { - if ($entry->{type} eq 'desktop') { - my $desktop = $entry->{desktop}; - - my $name = $desktop->{Name}; - - $output .= "\t" x $indent; - $output .= "\t\"$name\"\n"; - - - my @v = %$desktop; - $output .= "@v\n" if $name eq ''; - } - elsif ($entry->{type} eq 'menu') { - $output .= output_readable ($entry->{menu}, $indent + 1); - } - else { - print STDERR "wrong menu entry type: $entry->{type}"; - } - - } - - return $output; -} - -sub get_root_menu -{ - foreach my $dir (split(/:/, $ENV{XDG_CONFIG_DIRS}), "/etc/xdg") { - check_file("$dir/menus/applications.menu"); - return "$dir/menus/applications.menu" if -f "$dir/menus/applications.menu"; - } - return ""; -} - -sub get_app_dirs -{ - my %used; - my $ret = ''; - my @kde_xdgdata = split(/:/, `kde-config --path xdgdata-apps`); - - foreach $_ (@kde_xdgdata) { - s/\/applications\/*\s*$//; - }; - - foreach my $d (split(/:/, $ENV{XDG_DATA_DIRS}), @kde_xdgdata, "/usr/share", "/opt/gnome/share") { - my $dir = $d; - $dir =~ s/\/*$//; - next if defined $used{$dir}; - next if check_file("$dir/applications") ne 'D'; - $ret .= ':' if $ret ne ''; - $ret .= "$dir/applications"; - $used{$dir} = 1; - } - return $ret; -} - -sub get_desktop_dirs -{ - my %used; - my $ret = ''; - foreach my $dir (split(/:/, $ENV{XDG_DATA_DIRS}), "/usr/share", "/opt/kde3/share", "/opt/gnome/share") { - next if defined $used{$dir}; - next if check_file("$dir/desktop-directories") ne 'D'; - $ret .= ':' if $ret ne ''; - $ret .= "$dir/desktop-directories"; - $used{$dir} = 1; - } - return $ret; -} - -sub get_KDE_legacy_dirs -{ - my %used; - my @ret; - foreach my $d ("/etc/opt/kde3/share/applnk", "/opt/kde3/share/applnk", reverse(split(/:/, `kde-config --path apps`))) { - my $dir = $d; - chomp $dir; - $dir =~ s/\/*$//; - next if defined $used{$dir}; - next if check_file("$dir") ne 'D'; - $used{$dir} = 1; - push @ret, $dir; - } - return @ret; -} - -sub prepare_language_keys ($) -{ - my ($language) = @_; - - my @keys; - - $language =~ s/\.[^@]*//; # remove .ENCODING - - if ($language =~ /^([^_]*)_([^@]*)@(.*)$/) { # LANG_COUNTRY@MODIFIER - push @keys, $1 . '_' . $2 . '@' . $3; - push @keys, $1 . '_' . $2; - push @keys, $1 . '@' . $3; - push @keys, $1; - } - elsif ($language =~ /^([^_]*)_([^@]*)$/) { # LANG_COUNTRY - push @keys, $1 . '_' . $2; - push @keys, $1; - } - elsif ($language =~ /^([^_]*)@(.*)$/) { # LANG@MODIFIER - push @keys, $1 . '@' . $2; - push @keys, $1; - } - elsif ($language =~ /^([^_@]*)$/) { # LANG - push @keys, $1; - } - - return @keys; -} - -sub check_cache -{ - my $cachedir = $ENV{HOME}; - - return unless -d $cachedir; - - $cachedir .= "/.xdg_menu_cache"; - - return unless -f "$cachedir/inputs" && -f "$cachedir/output"; - - my @st = stat "$cachedir/output"; - my $ref_time = $st[10]; #ctime - - open(FILE, "<$cachedir/inputs"); - - my $num_opts = 0; - - while (<FILE>) { - chomp; - next if /^\s*$/; - next if /^#/; - - if (/^[FD] (.*)$/) { - my $file = $1; - my @st = stat $file; - my $time = $st[10]; #ctime - - if (!defined $time || $time >= $ref_time) { -# print STDERR "$file: is newer\n"; - return; - } - } - elsif (/^X (.*)$/) { - my $file = $1; - - if (-e $file) { -# print STDERR "$file: exists\n"; - return; - } - } - elsif (/^ENV ([^ ]+) (.*)$/) { - my $var = $1; - my $val = $2; - - if ($ENV{$var} ne $val) { -# print STDERR "$var: differs\n"; - return; - } - } - elsif (/^OPT ([0-9]+) (.*)$/) { - my $optidx = $1; - my $val = $2; - - $num_opts ++; - if ($save_ARGV[$optidx] ne $val) { -# print STDERR "$optidx: differs\n"; - return; - } - } - elsif (/^CHARSET (.*)$/) { - my $charset = $1; - - if ($charset ne langinfo(CODESET)) { -# print STDERR "charset $charset differs\n"; - return; - } - } - elsif (/^LANGUAGE (.*)$/) { - my $language = $1; - - if ($language ne setlocale(LC_MESSAGES)) { -# print STDERR "language $language differs\n"; - return; - } - } - elsif (/^VERSION (.*)$/) { - my $v = $1; - - if ($v ne $Version) { -# print STDERR "Version differs\n"; - return; - } - } - else { - print STDERR "Wrong cache inputs list\n"; - return; - } - - - } - - return if $num_opts != @save_ARGV; - - open(FILE, "<$cachedir/output") or return; - - print STDERR "Using cached output\n" if $verbose; - - my $buf; - while(read(FILE, $buf, 4096)) { - print $buf; - } - close(FILE); - - exit 0; -} - -sub write_cache ($) -{ - my ($output) = @_; - - my $cachedir = $ENV{HOME}; - - return unless -d $cachedir; - - $cachedir .= "/.xdg_menu_cache"; - - mkdir $cachedir; - unlink "$cachedir/output"; - - open(FILE, ">$cachedir/inputs") or return; - print FILE "# this file contains list of inputs xdg_menu\n"; - print FILE "VERSION $Version\n"; - print FILE "\n\n"; - print FILE join("\n", @accessed_files); - print FILE "\n\n"; - - for (my $i = 0; $i < @save_ARGV; $i++) { - print FILE "OPT $i $save_ARGV[$i]\n"; - } - - print FILE "ENV XDG_CONFIG_DIRS $ENV{XDG_CONFIG_DIRS}\n"; - print FILE "ENV XDG_DATA_DIRS $ENV{XDG_DATA_DIRS}\n"; - - print FILE "CHARSET " . langinfo(CODESET) . "\n"; - print FILE "LANGUAGE " . setlocale(LC_MESSAGES) . "\n"; - - close(FILE); - open(FILE, ">$cachedir/output") or return; - print FILE $output; - close(FILE); -} - - -check_cache(); - -use XML::Parser; - -$DefaultAppDirs = get_app_dirs(); -$DefaultDirectoryDirs = get_desktop_dirs(); - -my $root_menu = get_root_menu(); - -@KDELegacyDirs = get_KDE_legacy_dirs(); - -$charset = langinfo(CODESET); -$language = setlocale(LC_MESSAGES); - -$root_cmd = "/opt/gnome/bin/gnomesu" if -x '/opt/gnome/bin/gnomesu'; -$root_cmd = "/opt/kde3/bin/kdesu" if -x '/opt/kde3/bin/kdesu'; - -my $help; - -GetOptions("format=s" => \$format, - "fullmenu" => \$fullmenu, - "desktop=s" => \$desktop_name, - "charset=s" => \$charset, - "language=s" => \$language, - "root-menu=s" => \$root_menu, - "die-on-error" => \$die_on_error, - "verbose" => \$verbose, - "help" => \$help - ); - -@language_keys = prepare_language_keys($language); - -$desktop_name = $format unless defined $desktop_name; - -if ($help) { - print <<"EOF"; - -xdg-menu - XDG menus for WindowMaker and other window managers - http://freedesktop.org/Standards/menu-spec - - -Usage: - xdg_menu [--format <format>] [--desktop <desktop>] - [--charset <charset>] [--language <language>] - [--root-menu <root-menu>] [--die-on-error] - [--fullmenu] [--help] - - format - output format - possible formats: WindowMaker, fvwm2, icewm, - blackbox, fluxbox, openbox, - xfce4, openbox3, openbox3-pipe, - mwm, readable - default: WindowMaker - - fullmenu - output a full menu and not only a submenu - - desktop - desktop name for NotShowIn and OnlyShowIn - default: the same as format - - charset - output charset - default: $charset - - language - output language - default: $language - - root-menu - location of root menu file - default: $root_menu - - die-on-error - abort execution on any error, - default: try to continue - - verbose - print debugging information - - help - print this text - -EOF - exit 0; -} - - -unless ( -f $root_menu) { - print STDERR "Can't find root menu file.\n"; - exit 1; -} - -my $tree = read_menu($root_menu); - -merge_menus($tree); -move_menus($tree); - -my $menu = interpret_root($tree, ''); - -remove_allocated($menu); -preprocess_menu($menu); -remove_empty_menus($menu); - -my $output; - -if ($format eq 'WindowMaker') { - - $output = output_wmaker_menu($menu) -} -elsif ($format eq 'fvwm2') { - - $output = output_fvwm2_menu($menu) -} -elsif ($format eq 'icewm') { - foreach my $entry (@{$menu->{'entries'}}) { - - if ($entry->{type} eq 'menu') { - $output .= output_icewm_menu ($entry->{'menu'}); - } - } -} -elsif ($format eq 'xfce4') { - - $output = output_xfce4_menu($menu) -} -elsif ($format eq 'blackbox' || ($format eq 'openbox') || ($format eq 'fluxbox') ) { - if ($fullmenu) { - $output = output_blackbox_menu($menu) - } - else - { - $output = output_blackbox_inner_menu($menu) - } -} -elsif ($format eq 'openbox3') { - if ($fullmenu) { - $output = output_openbox3_menu($menu) - } - else - { - $output = output_openbox3_inner_menu($menu) - } -} -elsif ($format eq 'openbox3-pipe') { - - $output = output_openbox3_pipe_menu($menu) -} -elsif ($format eq 'twm') { - - print STDERR "WARNING: twm does not support umlauts. Parameter --language '' to output plain ASCII.\n" unless $language eq ''; - $output = output_twm_menu($menu) -} -elsif ($format eq 'mwm') { - - $output = output_twm_menu($menu) -} -elsif ($format eq 'readable') { - - $output = output_readable($menu) -} -else -{ - print STDERR "Unknown format $format\n"; - exit 1; -} - -print $output; -write_cache($output); - -exit 0; - |