5 # Changed on 11/30/10 by (dane):
6 # - changed DIR filehandles to scalars, they're stepping on each other.
7 # was a bug in xdg-menu.
8 # - changed default (only) format to fvwm2 and removed logic for other wms.
9 # - move mainline before all subs (move it back?).
10 # - removed the xdg_menu cache logic.
11 # - Remove $flag, $MENU_TYPE, $MENU_DESTROY for gtk vs. fvwm menu mode.
12 # Actually removed all GTK MENU logic.
13 # - Added option to menu to regenerate the menus.
14 # - Remove xdg option root_menu.
15 # - Added fvwm-menu option to use Fvwm Icons package.
16 # - Style options from fvwmmenudesktop not carried over,
17 # WM hints are sufficient to set mini-icon and icon.
18 # - Removed prototypes. None were needed.
19 # - All filehandle names made local.
20 # - New option for su_gui, do path check for alternatives.
22 # - Change menu prefix from xdg-menu to FvwmMenu
25 # - No testing for wm_icons has been done (is that fvwm-themes?).
26 # - Docs need to be updated.
27 # - fvwm-icons: okay, maybe the cat isn't a good default for Exec...
28 # - Running alacarte, I can see there are Application menus, and System menus.
29 # Figure out the options to get both.
30 # - There are good programs like alacarte that are marked GNOME-ONLY.
31 # Figure out how to get them in menus.
32 # - I think this should default to mini-icons enabled, but which
33 # icon package should be assumed?
34 # - Need a way to select the /usr/share/icons icon sets with themes like
35 # default/hicolor and size like 16x16 and 24x24.
36 # - Regenerate menus should prompt for a new command line.
37 # - sidepics, etc not tested.
38 # - iconname::: syntax needs investigation, I think some of it is obsolete,
39 # needs a verifier, and some defaults.
40 # - Far too many lexical globals not bound to subroutines (c.f.
42 # - I don't see the point to the path arguments. I think they should
44 # - If I pass --fvwm-icons I don't need to set --enable-mini-icons.
45 # Therefore I think enable mini-icons is pointless.
46 # - The "check" functions are useless. Since this module doesn't get the
47 # built in path, or the users path, it can't do the check.
48 # - Looks like there is no such thing as fvwm_toptitle, must have been a gtk thing?
50 # ---------------------------------------------------------------------------
52 # See the man page fvwm-menu-desktop.1 for instructions.
54 # Created on 22/07/1999 by Olivier Chapuis
56 # Updated on 15/08/1999 by Mikhael Goikhman
58 # Updated on 24/12/2010 by Dan Espen for xdg menus (see copyright below)
59 # ---------------------------------------------------------------------------
62 # The script is distributed by the same terms as fvwm itself.
63 # See GNU General Public License for details.
65 #----------------------------------------------------------------------------
67 # 25/12/2010 re-written, based heavily on
68 # xdg-menu for archlinux. based on suse xdg-menu written by <nadvornik@suse.cz>
69 # Sergej Pupykin <pupykin.s@gmail.com>
71 # >> Copyright (c) 2003 SuSE Linux AG, Nuernberg, Germany. All rights reserved.
73 # >> Author: nadvornik@suse.cz
80 use I18N::Langinfo qw(langinfo CODESET);
81 use POSIX qw(locale_h);
82 use Digest::MD5 qw(md5_hex);
85 my $xdg_data_dirs = $ENV{XDG_DATA_DIRS} || '';
86 my $xdg_config_dirs = $ENV{XDG_CONFIG_DIRS} || '';
87 my @PATH_DIRS = split(':',$ENV{PATH}); # for checking if applications exist
89 my $version = '@VERSION@';
90 my $menu_prefix='FvwmMenu';
92 my $DefaultDirectoryDirs;
94 my $desktop_name = 'fvwm2';
96 my $charset = 'iso-8859-1';
104 my $TERM_CMD = "xterm -e";
108 my %Directory_entries;
113 # Default for the mini-icons is mini/ (relatively to the ImagePath)
114 my $MINI_ICONS_DIR = 'mini/';
115 # Then the default for icon is ImagePath (consistent with kde, fvwm2gnome
116 # and almost consistent with wm-icons)
120 my $TRAN_MINI_ICONS = 'mini/';
122 my $MINI_ICONS = 0; # mini-icon disabled (enable =1)
123 my $TRAN = 0; # mini-icon translation disabled (enable =1)
124 my $wm_icons = 0; # use wm-icons compatible menu icon names
125 my $fvwm_icons = 0; # use fvwm-icons compatible menu icon names
127 my $check_icons = "";
128 my $check_mini_icons = "";
129 my @check_icons_path = ();
130 my @check_mini_icons_path = ();
135 my @menus_for_style = ();
138 $DI{fvwm_app} = 'mini-x.xpm:dh:%::'; # micon:law:placement:unused
139 $DI{fvwm_folder} = 'folder.xpm:dh:%::'; # idem
140 $DI{fvwm_title} = 'folder.xpm:dh:%::'; # micon:law:place:spic:color
141 $DI{fvwm_toptitle} = 'mini-k.xpm:no:%::'; # idem
142 my $OPT_INSTALL_PREFIX = '';
144 warn "invoked with args @ARGV\n" if $verbose;
147 "enable-mini-icons" => \$MINI_ICONS,
148 "enable-tran-mini-icons" => \$TRAN,
149 "mini-icons-path:s" => \$MINI_ICONS_DIR,
150 "png-icons-path:s" => \$PNG_ICONS,
151 "tran-mini-icons-path:s" => \$TRAN_MINI_ICONS,
152 "icon-toptitle:s" => \$DI{"fvwm_toptitle"},
153 "icon-title:s" => \$DI{"fvwm_title"},
154 "icon-folder:s" => \$DI{"fvwm_folder"},
155 "icon-app:s" => \$DI{"fvwm_app"},
156 "icon-style:s" => \&obsolete,
157 "icons-path:s" => \$ICONS_DIR,
158 "tran-icons-path:s" => \$TRAN_ICONS,
159 "wm-icons" => \$wm_icons,
160 "fvwm-icons" => \$fvwm_icons,
161 "check-mini-icon=s" => \$check_mini_icons,
162 "check-icons=s" => \$check_icons,
163 "help|h|?" => \&show_help,
164 "version|V" => \&show_version,
165 "install-prefix:s" => $OPT_INSTALL_PREFIX,
166 "type:s" => \&obsolete,
167 "fvwmgtk-alias=s" => \&obsolete,
168 "title:s" => \&obsolete,
169 "name:s" => \&obsolete,
170 "enable-style" => \&obsolete,
171 "enable-tran-style" => \&obsolete,
172 "submenu-name-prefix:s" => \&obsolete,
173 "dir:s" => \&obsolete,
174 "destroy-type:s" => \&obsolete,
175 "xterm:s" => \$TERM_CMD,
176 "lang:s" => \$language,
177 "utf8" => \&obsolete,
178 "uniconv=s" => \$charset,
179 "uniconv-exec=s" => \&obsolete,
180 "menu-style=s" => \$MENU_STYLE,
181 "check-app!" => \&obsolete,
182 "time-limit=s" => \&obsolete,
183 "merge-user-menu" => \&obsolete,
185 "su_gui" => \$root_cmd,
186 "verbose" => \$verbose
191 $DefaultAppDirs = get_app_dirs();
192 $DefaultDirectoryDirs = get_desktop_dirs();
194 $root_menu = get_root_menu();
196 @KDELegacyDirs = get_KDE_legacy_dirs();
198 $charset = langinfo(CODESET);
199 $language = setlocale(LC_MESSAGES);
201 if (! defined $root_cmd )
203 foreach (qw(gnomesu kdesu xdg_menu_su))
216 DEBUG: root menu is $root_menu
217 DEBUG: charset is $charset.
218 DEBUG: language is $language.
219 DEBUG: root-cmd is $root_cmd.|;
222 @language_keys = prepare_language_keys($language);
224 unless (-f $root_menu)
226 warn "ERROR: Can't find root menu file.\n";
230 my $tree = read_menu($root_menu);
235 my $menu = interpret_root($tree, '');
237 remove_allocated($menu);
238 preprocess_menu($menu);
239 remove_empty_menus($menu);
241 my $output = output_fvwm2_menu($menu);
244 # output the menu style
245 if ($MENU_STYLE ne "")
247 foreach (@menus_for_style)
249 print qq|ChangeMenuStyle "$MENU_STYLE" "$_"\n|;
255 # Set DI to list of icons to use:
270 $MINI_ICONS_DIR = "";
271 $DI{"fvwm_toptitle"} = "menu/folder-open.xpm:ow";
272 $DI{"fvwm_title"} = "menu/folder-open.xpm:ow";
273 $DI{"fvwm_folder"} = "menu/folder.xpm:ow";
274 $DI{"fvwm_app"} = "menu/utility.xpm:ow";
280 $MINI_ICONS_DIR = "";
281 $DI{"fvwm_toptitle"} = "mini.fvwm.xpm::%";
282 $DI{"fvwm_title"} = "mini.folder.xpm::%";
283 $DI{"fvwm_folder"} = "mini.ofolder.xpm::%";
284 $DI{"fvwm_app"} = "mini.cat.xpm::%";
287 foreach my $i (keys(%DI))
289 @list = split(':',$DI{$i});
290 $dmicon{$i} = $list[0]; # "default" mini-icon
291 $law{$i} = $list[1]; # default law
292 $place{$i} = $list[2]; # default position
293 $spic{$i} = $list[3]; # sidepic icon
294 $scolor{$i} = $list[4]; # color for sidepic
303 if ($MINI_ICONS_DIR ne 'mini/' or $ICONS_DIR ne '')
305 if ($MINI_ICONS_DIR ne '')
307 $MINI_ICONS_DIR =~ s/\/*$/\//;
310 if ($ICONS_DIR eq '')
312 $ICONS_DIR = up_directory($MINI_ICONS_DIR);
314 elsif ($ICONS_DIR eq 'inpath')
320 $ICONS_DIR =~ s/\/*$/\// if $MINI_ICONS_DIR ne '';
324 if ($TRAN_MINI_ICONS ne 'mini/' or $TRAN_ICONS ne '')
326 if ($TRAN_MINI_ICONS ne '')
328 $TRAN_MINI_ICONS =~ s/\/*$/\//;
331 if ($TRAN_ICONS eq '')
333 $TRAN_ICONS = up_directory($TRAN_MINI_ICONS);
335 elsif ($TRAN_ICONS eq 'inpath')
341 $TRAN_ICONS =~ s/\/*$/\// if $TRAN_ICONS ne '';
345 $PNG_ICONS =~ s/\/*$/\// if $PNG_ICONS ne '';
347 # init default mini-icons, law, place, sidepic, color
348 foreach my $i (qw(fvwm_app fvwm_folder fvwm_title fvwm_toptitle))
350 warn "DEBUG: foreach $i.\n" if $verbose; # dje debug
351 # With the mini-icons-tran options we "use" gtk default
354 $j = substr($i,index($i,'_'));
357 $tmp_icon = $dmicon{$j};
358 $tmp_icon =~ s/\.png$/\.xpm/;
359 $dmicon{$i} = "$TRAN_MINI_ICONS$tmp_icon";
363 $dmicon{$i} = "$MINI_ICONS_DIR$dmicon{$i}";
368 while (my ($key,$value) = each %dmicon)
370 warn "INTERMEDIATE icons to use $key -> $value.\n";
373 @list = split(':',$DI{$i});
380 $law{$i} = $list[1] if ($list[1] eq 'no' or $list[1] eq 'ow'
381 or $list[1] eq 're' or $list[1] eq 'dh');
382 $dmicon{$i} = "$MINI_ICONS_DIR$list[0]" if $list[0] ne '';
383 $place{$i} = '*' if $list[2] eq 'up';
384 $dmicon{$i} = "$place{$i}$dmicon{$i}$place{$i}";
385 $dmicon{$i} = '' if $law{$i} eq 'no' or $MINI_ICONS == 0;
389 $spic{$i} = "\@$list[3]\@";
396 if ($list[4] ne '' and $list[3] ne '')
398 $scolor{$i} = "\^$list[4]\^";
405 if ($check_mini_icons ne "")
407 @check_mini_icons_path = split(":", $check_mini_icons);
410 if ($check_icons ne "")
412 @check_icons_path = split(":", $check_icons);
417 while (my ($key, $value) = each %dmicon)
419 warn "icons to use $key -> $value.\n";
422 @list = split(':',$DI{$i});
429 $law{$i} = $list[1] if ($list[1] eq 'no' or $list[1] eq 'ow'
430 or $list[1] eq 're' or $list[1] eq 'dh');
431 $dmicon{$i} = "$MINI_ICONS_DIR$list[0]" if $list[0] ne '';
432 $place{$i} = '%'; # default
434 if ($list[2] eq 'up')
438 $dmicon{$i} = "$place{$i}$dmicon{$i}$place{$i}";
439 $dmicon{$i} = '' if ($law{$i} eq 'no' || $MINI_ICONS == 0);
442 $spic{$i} = "\@$list[3]\@";
448 if ($list[4] ne '' and $list[3] ne '')
450 $scolor{$i} = "\^$list[4]\^";
457 if ($check_mini_icons ne "")
459 @check_mini_icons_path = split(":", $check_mini_icons);
462 if ($check_icons ne "")
464 @check_icons_path = split(":", $check_icons);
469 while (my ($key, $value) = each %dmicon)
471 warn "icons to use $key -> $value.\n";
492 $dir = substr($dir, 0, rindex($dir, '/') + 1);
515 my ($pool, $dir, $topdir) = @_;
519 $topdir = $dir unless defined $topdir;
521 return if check_file($dir) ne 'D';
523 opendir( my $dir_fh, $dir ) or return;
524 foreach my $entry ( readdir($dir_fh) )
526 if (-f "$dir/$entry" and $entry =~ /\.desktop$/)
528 read_desktop_entry($pool, "$dir/$entry", $topdir);
530 elsif (-d "$dir/$entry" and $entry !~ /^\.{1,2}$/
531 and $entry ne '.hidden')
533 scan_AppDir($pool, "$dir/$entry", $topdir);
539 sub scan_DirectoryDir
541 my ($pool, $dir, $topdir) = @_;
544 $topdir = $dir unless defined $topdir;
546 opendir( my $dir_fh, $dir ) or return;
547 foreach my $entry (readdir($dir_fh))
549 if (-f "$dir/$entry" and $entry =~ /\.directory$/)
551 read_directory_entry( $pool, "$dir/$entry", $topdir );
553 elsif (-d "$dir/$entry" and $entry !~ /^\.{1,2}$/
554 and $entry ne '.hidden')
556 scan_DirectoryDir($pool, "$dir/$entry", $topdir);
562 sub read_directory_entry
564 my ($pool, $file, $topdir) = @_;
566 unless (defined $Directory_entries{$file})
572 warn "Read directory entry, opening file $file.\n";
574 open( my $file_fh, "<", $file ) or return;
575 my $in_desktop_entry = 0;
581 if (/^\[Desktop Entry\]/)
583 $in_desktop_entry = 1;
587 $in_desktop_entry = 0;
590 elsif ($in_desktop_entry and /^([^=]*)=([^[:cntrl:]]*)/)
602 $Directory_entries{$file} = \%entry;
604 my $entry = $Directory_entries{$file};
605 $pool->{'Directory_entries'}{ $entry->{'id'} } = $entry;
612 return 1 unless defined $entry;
614 my (%OnlyShowIn, %NotShowIn);
616 if (defined $entry->{'OnlyShowIn'})
618 foreach my $showin (split /;/, $entry->{'OnlyShowIn'})
620 $OnlyShowIn{$showin} = 1;
623 return 0 unless defined $OnlyShowIn{$desktop_name};
626 if (defined $entry->{'NotShowIn'})
628 foreach my $showin (split /;/, $entry->{'NotShowIn'})
630 $NotShowIn{$showin} = 1;
633 return 0 if defined $NotShowIn{$desktop_name};
639 sub read_desktop_entry
641 my ($pool, $file, $topdir) = @_;
643 unless (defined $Desktop_entries{$file})
650 warn "Read desktop entry, opening file $file.\n";
653 open( my $file_fh, "<", $file ) or return;
655 my $entry = $Desktop_entries{$file};
657 return unless defined $entry->{'Name'};
658 return unless defined $entry->{'Exec'};
660 if (defined $entry->{'Hidden'} and $entry->{'Hidden'} eq 'true')
665 #FIXME, an option for this would be good
667 if (defined $entry->{'NoDisplay'} and $entry->{'NoDisplay'} eq 'true')
672 return unless check_show_in($entry);
674 if (defined $entry->{'NotShowIn'} and
675 $entry->{'NotShowIn'} eq $desktop_name)
680 if (defined $pool and defined $entry->{'Categories'})
682 foreach my $category (split /;/, $entry->{'Categories'})
684 $pool->{'Categories'}{$category} = []
685 unless defined $pool->{'Categories'}{$category};
687 push @{ $pool->{'Categories'}{$category} }, $entry;
689 $pool->{'Desktop_entries'}{ $entry->{'id'} } = $entry;
695 sub read_desktop_entries
697 my ($directory_paths, $desktop_paths) = @_;
699 'Desktop_entries' => {},
701 'Directory_entries' => {},
702 'Directory_paths' => $directory_paths,
703 'Desktop_paths' => $desktop_paths
706 foreach my $dir (split /:/, $directory_paths)
708 next if $dir =~ /^\s*$/;
709 scan_DirectoryDir( $pool, $dir );
712 foreach my $dir (split /:/, $desktop_paths)
714 next if $dir =~ /^\s*$/;
715 scan_AppDir( $pool, $dir );
721 sub get_directory_entry
723 my ($entry, $pool) = @_;
724 return $pool->{'Directory_entries'}{$entry};
727 sub interpret_Include
729 my ( $tree, $entries, $pool ) = @_;
731 my @list = interpret_entry_node( $tree, 'Or', $pool );
732 foreach my $e (@$entries)
734 if ( $e->{type} eq 'desktop' )
736 $exist{ $e->{desktop} } = 1;
740 foreach my $entry (@list)
742 next if $exist{$entry};
743 push @$entries, { type => 'desktop', desktop => $entry };
744 $entry->{'refcount'}++;
749 sub interpret_Exclude
751 my ( $tree, $entries, $pool ) = @_;
752 my @list = interpret_entry_node( $tree, 'Or', $pool );
753 foreach my $entry (@list)
756 while ( defined $entries->[$i] )
758 my $exist = $entries->[$i];
759 if ($exist->{type} eq 'desktop' and
760 $exist->{desktop} eq $entry )
762 splice @$entries, $i, 1;
763 $entry->{'refcount'}--;
773 sub interpret_entry_node
775 my ( $tree, $node, $pool ) = @_;
777 $i++ if ( ref( $tree->[$i] ) eq 'HASH' );
779 while (defined $tree->[$i])
781 if ($tree->[$i] eq 'Filename')
784 if (ref( $tree->[$i][0] ) eq 'HASH' and $tree->[$i][1] eq '0')
786 my $entry = $tree->[$i][2];
787 if (defined $pool->{'Desktop_entries'}{$entry})
789 push @subtree, [ $pool->{'Desktop_entries'}{$entry} ];
799 exit 1 if $die_on_error;
803 elsif ($tree->[$i] eq 'Category')
806 if (ref( $tree->[$i][0] ) eq 'HASH' and $tree->[$i][1] eq '0')
808 my $category = $tree->[$i][2];
809 if (defined $pool->{'Categories'}{$category})
811 push @subtree, $pool->{'Categories'}{$category};
821 exit 1 if $die_on_error;
825 elsif ($tree->[$i] eq 'All')
828 if (values %{ $pool->{'Desktop_entries'} } > 0)
830 push @subtree, [ values %{ $pool->{'Desktop_entries'} } ];
838 elsif ($tree->[$i] eq '0')
845 my @res = interpret_entry_node(
846 $tree->[ $i + 1 ], $tree->[$i], $pool
849 push @subtree, \@res;
859 foreach my $st (@subtree)
861 foreach my $entry (@$st)
863 if (!defined $used{$entry})
872 elsif ($node eq 'And')
877 my $min = @{ $subtree[0] };
880 foreach my $st (@subtree)
890 foreach my $entry (@$st)
892 next if $dupes{$entry};
895 if (!defined $used{$entry})
907 return () if $cnt == 0;
909 foreach my $entry (@{ $subtree[$min_idx] })
911 push @res, $entry if $used{$entry} == $cnt;
916 elsif ($node eq 'Not')
922 foreach my $st (@subtree) {
923 foreach my $entry (@$st) {
928 foreach my $entry (values %{ $pool->{'Desktop_entries'} })
930 push @res, $entry if !defined $used{$entry};
937 warn "Can't use '$node' inside <Include> or <Exclude>\n";
938 exit 1 if $die_on_error;
945 my ($tree, $topdir) = @_;
947 if ($tree->[0] eq 'Menu')
949 return interpret_menu( $tree->[1] );
953 warn "No toplevel Menu\n";
954 exit 1 if $die_on_error;
961 my ($tree, $directory_paths, $desktop_paths) = @_;
963 $directory_paths = '' unless defined $directory_paths;
964 $desktop_paths = '' unless defined $desktop_paths;
968 'OnlyUnallocated' => 0,
969 'DontShowIfEmpty' => 0,
975 $i++ if ref $tree->[$i] eq 'HASH';
977 while (defined $tree->[$i])
979 if ($tree->[$i] eq 'AppDir')
981 if (ref( $tree->[ $i + 1 ][0] ) eq 'HASH'
982 and $tree->[ $i + 1 ][1] eq '0')
984 $desktop_paths .= ':' . $tree->[ $i + 1 ][2];
985 splice @$tree, $i, 2;
989 warn "wrong AppDir\n";
990 exit 1 if $die_on_error;
995 elsif ($tree->[$i] eq 'DefaultAppDirs')
997 $desktop_paths .= ':' . $DefaultAppDirs;
998 splice @$tree, $i, 2;
1000 elsif ($tree->[$i] eq 'DirectoryDir')
1002 if (ref( $tree->[ $i + 1 ][0]) eq 'HASH'
1003 and $tree->[ $i + 1 ][1] eq '0')
1005 $directory_paths .= ':' . $tree->[ $i + 1 ][2];
1006 splice @$tree, $i, 2;
1010 warn "wrong DirectoryDir\n";
1011 exit 1 if $die_on_error;
1016 elsif ($tree->[$i] eq 'DefaultDirectoryDirs')
1018 $directory_paths .= ':' . $DefaultDirectoryDirs;
1019 splice @$tree, $i, 2;
1028 $menu{directory_paths} = $directory_paths;
1029 $menu{desktop_paths} = $desktop_paths;
1031 my $pool = read_desktop_entries( $directory_paths, $desktop_paths );
1034 $i++ if ref $tree->[$i] eq 'HASH';
1036 while (defined $tree->[$i])
1038 if ($tree->[$i] eq 'Menu')
1041 my $submenu = interpret_menu(
1042 $tree->[$i], $directory_paths, $desktop_paths
1045 push( @{ $menu{'entries'} },
1046 { type => 'menu', menu => $submenu }
1050 elsif ($tree->[$i] eq 'Name')
1053 if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0')
1055 $menu{'Name'} = $tree->[$i][2];
1056 exit 1 if $die_on_error;
1060 elsif ($tree->[$i] eq 'Directory')
1063 if (ref( $tree->[$i][0] ) eq 'HASH' and $tree->[$i][1] eq '0')
1065 $menu{'Directory'} = get_directory_entry(
1066 $tree->[$i][2], $pool
1071 warn "wrong Directory\n";
1072 exit 1 if $die_on_error;
1076 elsif ($tree->[$i] eq 'OnlyUnallocated')
1078 $menu{'OnlyUnallocated'} = 1;
1082 elsif ($tree->[$i] eq 'DontShowIfEmpty')
1084 $menu{'DontShowIfEmpty'} = 1;
1088 elsif ($tree->[$i] eq 'Deleted')
1090 $menu{'Deleted'} = 1;
1094 elsif ($tree->[$i] eq 'NotDeleted')
1096 $menu{'Deleted'} = 0;
1100 elsif ($tree->[$i] eq 'Include')
1103 interpret_Include($tree->[$i], $menu{'entries'}, $pool);
1106 elsif ($tree->[$i] eq 'Exclude')
1109 interpret_Exclude($tree->[$i], $menu{'entries'}, $pool);
1112 elsif ($tree->[$i] eq '0')
1115 if ($tree->[$i] !~ /^\s*$/)
1117 print STDERR "skip '$tree->[$i]'\n";
1118 exit 1 if $die_on_error;
1124 warn "Unknown '$tree->[$i]':\n";
1126 warn " '@{$tree->[$i]}'\n";
1128 exit 1 if $die_on_error;
1137 my ($file, $basedir) = @_;
1139 if ($file !~ /^\// and defined $basedir)
1141 $file = "$basedir/$file";
1144 unless (defined $basedir)
1147 $basedir =~ s/\/[^\/]*$//;
1150 unless (check_file($file))
1152 warn "WARNING: '$file' does not exist\n";
1153 return [ 'Menu', [ {} ] ];
1156 warn "reading '$file'\n" if $verbose;
1158 my $parser = XML::Parser->new(Style => 'Tree');
1159 my $tree = $parser->parsefile($file);
1161 my $DefaultMergeDir = $file;
1162 $DefaultMergeDir =~ s/^.*\///;
1163 $DefaultMergeDir =~ s/\.menu$/-merged/;
1165 read_includes($tree, $basedir, $DefaultMergeDir);
1172 my ($dir, $basedir) = @_;
1176 if ($dir !~ /^\// and defined $basedir)
1178 $dir = "$basedir/$dir";
1181 if (check_file($dir) ne 'D')
1186 opendir( my $dir_fh, $dir );
1187 foreach my $entry (readdir($dir_fh))
1190 if (-f "$dir/$entry" and $entry =~ /\.menu$/)
1192 my $menu = read_menu("$dir/$entry");
1193 $menu = remove_toplevel_Menu($menu);
1206 $txt =~ s/&/&/g;
1214 my ($dir, $basedir) = @_;
1219 $basedir = $dir unless defined $basedir;
1221 return "" if check_file($dir) ne 'D';
1225 if ($dir eq $basedir)
1227 my $xmldir = quote_xml($dir);
1229 $out .= "<AppDir>$xmldir</AppDir>\n";
1230 $out .= "<DirectoryDir>$xmldir</DirectoryDir>\n";
1238 $name = quote_xml($name);
1239 $out .= "<Name>$name</Name>\n";
1242 if (-f "$dir/.directory")
1244 my $dir_id = "$dir/.directory";
1245 $dir_id =~ s/^$basedir//;
1247 $dir_id = quote_xml($dir_id);
1249 $out .= "<Directory>$dir_id</Directory>\n";
1252 if (opendir(my $dir_fh, $dir))
1254 foreach my $entry (readdir($dir_fh))
1256 if (-f "$dir/$entry" and $entry =~ /\.desktop$/)
1258 my $id = "$dir/$entry";
1259 $id =~ s/^$basedir//;
1262 $id = quote_xml($id);
1264 my $desktop = read_desktop_entry(
1265 undef, "$dir/$entry", $basedir
1268 $out .= "<Include><Filename>$id</Filename></Include>\n"
1269 unless defined $desktop->{'Categories'};
1271 elsif (-d "$dir/$entry" and $entry !~ /^\.{1,2}$/ and
1272 $entry ne '.hidden')
1274 $out .= read_legacy_dir( "$dir/$entry", $basedir );
1280 $out .= "</Menu>\n";
1284 sub remove_toplevel_Menu
1288 if ($tree->[0] eq 'Menu')
1290 shift @{ $tree->[1] } if ref $tree->[1][0] eq 'HASH';
1295 warn "No toplevel Menu\n";
1296 exit 1 if $die_on_error;
1303 my ($tree, $basedir, $DefaultMergeDir) = @_;
1305 $i++ if ref $tree->[$i] eq 'HASH';
1307 while (defined $tree->[$i])
1309 if ($tree->[$i] eq 'MergeFile')
1311 if (ref( $tree->[ $i + 1 ][0]) eq 'HASH'
1312 and $tree->[ $i + 1 ][1] eq '0')
1314 my $add_tree = read_menu(
1315 $tree->[ $i + 1 ][2], $basedir
1317 $add_tree = remove_toplevel_Menu($add_tree);
1319 splice @$tree, $i, 2, @$add_tree;
1323 warn "wrong MergeFile\n";
1324 exit 1 if $die_on_error;
1329 elsif ($tree->[$i] eq 'MergeDir')
1331 if (ref( $tree->[ $i + 1 ][0] ) eq 'HASH'
1332 and $tree->[ $i + 1 ][1] eq '0')
1334 my $add_tree = read_menu_dir( $tree->[ $i + 1 ][2], $basedir );
1335 splice @$tree, $i, 2, @$add_tree;
1339 warn "wrong MergeFile\n";
1340 exit 1 if $die_on_error;
1345 elsif ($tree->[$i] eq 'DefaultMergeDirs')
1347 my $add_tree = read_menu_dir( $DefaultMergeDir, $basedir );
1348 splice @$tree, $i, 2, @$add_tree;
1350 elsif ($tree->[$i] eq 'LegacyDir')
1352 if (ref( $tree->[ $i + 1 ][0] ) eq 'HASH'
1353 and $tree->[ $i + 1 ][1] eq '0')
1355 if (-d $tree->[ $i + 1 ][2])
1357 my $xml = read_legacy_dir( $tree->[ $i + 1 ][2] );
1358 warn "reading legacy directory '" . $tree->[ $i + 1 ][2] .
1361 my $parser = XML::Parser->new(Style => 'Tree');
1362 my $add_tree = $parser->parse($xml);
1363 $add_tree = remove_toplevel_Menu($add_tree);
1364 splice @$tree, $i, 2, @$add_tree;
1368 warn "legacy directory '"
1369 . $tree->[ $i + 1 ][2]
1372 splice @$tree, $i, 2, ();
1377 warn "wrong LegacyDir\n";
1378 exit 1 if $die_on_error;
1383 elsif ($tree->[$i] eq 'KDELegacyDirs')
1386 foreach my $dir (@KDELegacyDirs)
1388 my $xml = read_legacy_dir($dir);
1389 warn "reading legacy directory '$dir'\n" if $verbose;
1391 my $parser = new XML::Parser( Style => 'Tree' );
1392 my $add_tree = $parser->parse($xml);
1393 $add_tree = remove_toplevel_Menu($add_tree);
1394 push @out, @$add_tree;
1396 splice @$tree, $i, 2, @out;
1398 elsif ($tree->[$i] eq 'Menu')
1401 read_includes( $tree->[$i], $basedir, $DefaultMergeDir );
1419 $i++ if ref $tree->[$i] eq 'HASH';
1421 while (defined $tree->[$i])
1423 if ($tree->[$i] eq 'Name')
1426 if (ref( $tree->[$i][0] ) eq 'HASH' and $tree->[$i][1] eq '0')
1428 $name = $tree->[$i][2];
1433 warn "wrong Name\n";
1444 unless (defined $name)
1446 warn "Menu has no name element\n";
1454 my ($target, $source) = @_;
1457 $i++ if ref $source->[$i] eq 'HASH';
1459 while (defined $source->[$i])
1461 if ($source->[$i] ne 'Name')
1463 push @$target, $source->[$i];
1464 push @$target, $source->[ $i + 1 ];
1475 my %used; #menu name already used
1478 $i++ if ref $tree->[$i] eq 'HASH';
1480 while (defined $tree->[$i])
1482 if ($tree->[$i] eq 'Menu')
1484 my $name = get_menu_name($tree->[ $i + 1 ]);
1485 if (defined $used{$name})
1487 my $target = $used{$name};
1488 append_menu($tree->[$target], $tree->[ $i + 1 ]);
1490 splice @$tree, $i, 2;
1493 { # first appearance
1494 $used{$name} = $i + 1;
1507 $i++ if ref $tree->[$i] eq 'HASH';
1509 while (defined $tree->[$i])
1511 if ($tree->[$i] eq 'Menu')
1513 merge_menus($tree->[ $i + 1 ]);
1522 my ( $tree, $hash ) = @_;
1525 $i++ if ref $tree->[$i] eq 'HASH';
1527 while (defined $tree->[$i])
1529 if ($tree->[$i] eq 'Old')
1532 if (ref( $tree->[$i][0] ) eq 'HASH' and $tree->[$i][1] eq '0')
1534 $old = $tree->[$i][2];
1539 exit 1 if $die_on_error;
1543 if ($tree->[$i] eq 'New')
1546 if (ref( $tree->[$i][0] ) eq 'HASH' and $tree->[$i][1] eq '0')
1548 $hash->{$old} = $tree->[$i][2];
1553 exit 1 if $die_on_error;
1565 sub find_menu_in_tree
1567 my ( $path, $tree ) = @_;
1572 my $subpath = $path;
1573 $subpath =~ s/^[^\/]*\/*//;
1576 $i++ if ref $tree->[$i] eq 'HASH';
1578 while (defined $tree->[$i])
1580 if ($tree->[$i] eq 'Menu')
1582 if ($root eq get_menu_name( $tree->[ $i + 1 ]))
1589 'menu' => $tree->[ $i + 1 ]
1592 return find_menu_in_tree( $subpath, $tree->[ $i + 1 ] );
1599 #FIXME - TA: Don't return undef here, it's bad.
1605 my ($path, $tree) = @_;
1609 foreach my $elem (reverse split( /\//, $path))
1611 next if $elem eq '';
1612 my $menu = [ {}, 'Name', [ {}, 0, $elem ] ];
1613 push @$menu, ( 'Menu', $child ) if defined $child;
1614 $tail = $menu unless defined $tail;
1617 append_menu( $tail, $tree );
1626 $i++ if ref $tree->[$i] eq 'HASH';
1628 while (defined $tree->[$i])
1630 if ($tree->[$i] eq 'Move')
1632 read_Move($tree->[ $i + 1 ], \%move);
1633 splice @$tree, $i, 2;
1642 foreach my $source (keys %move)
1644 my $sourceinfo = find_menu_in_tree($source, $tree);
1646 if (defined $sourceinfo)
1648 my $target = copy_menu($move{$source}, $sourceinfo->{'menu'});
1649 splice @{ $sourceinfo->{'parent'} }, $sourceinfo->{'index'}, 2;
1650 push @$tree, ('Menu', $target);
1655 $i++ if ref $tree->[$i] eq 'HASH';
1657 while (defined $tree->[$i])
1659 if ($tree->[$i] eq 'Menu')
1661 move_menus($tree->[ $i + 1 ]);
1668 sub remove_allocated
1673 while ($i < @{ $menu->{'entries'} })
1675 my $entry = $menu->{'entries'}[$i];
1677 if ($entry->{type} eq 'menu')
1679 remove_allocated( $entry->{menu} );
1682 elsif ($entry->{type} eq 'desktop'
1683 and $menu->{'OnlyUnallocated'}
1684 and $entry->{desktop}{'refcount'} > 1)
1686 $entry->{desktop}{'refcount'}--;
1687 splice @{ $menu->{'entries'} }, $i, 1;
1697 sub remove_empty_menus
1702 while ($i < @{ $menu->{'entries'} })
1704 my $entry = $menu->{'entries'}[$i];
1706 if ($entry->{type} eq 'menu' and remove_empty_menus($entry->{menu}))
1708 splice @{ $menu->{'entries'} }, $i, 1;
1716 @{ $menu->{'entries'} } == 0 ? return 1 : return 0;
1721 my ( $exec, $desktop ) = @_;
1723 # Take out filename flags, etc.
1737 my $caption = $desktop->{Name};
1738 $exec =~ s/%c/$caption/g;
1741 if (defined $desktop->{Terminal})
1743 if ($desktop->{Terminal} eq '1' or $desktop->{Terminal} eq 'true')
1745 $exec = "$TERM_CMD $exec";
1749 if (defined $desktop->{'X-KDE-SubstituteUID'})
1751 if ($desktop->{'X-KDE-SubstituteUID'} eq '1'
1752 or $desktop->{'X-KDE-SubstituteUID'} eq 'true')
1754 $exec = "$root_cmd $exec"
1762 my ( $desktop, $entry ) = @_;
1764 foreach my $key (@language_keys)
1766 my $loc_entry = $entry . "[$key]";
1768 if (defined $desktop->{$loc_entry} and
1769 $desktop->{$loc_entry} !~ /^\s*$/)
1771 return $desktop->{$loc_entry};
1775 return $desktop->{$entry};
1780 # localize, sort, prepare_exec
1783 return 0 if $menu->{'Deleted'};
1784 return 0 unless check_show_in( $menu->{'Directory'} );
1786 if( defined $menu->{'Directory'} and
1787 defined $menu->{'Directory'}->{'NoDisplay'} and
1788 $menu->{'Directory'}->{'NoDisplay'} eq 'true')
1793 my $menu_name = $menu->{'Name'};
1794 if (defined $menu->{'Directory'})
1796 my $directory = $menu->{'Directory'};
1797 my $directory_name = get_loc_entry( $directory, 'Name' );
1799 if (defined $directory_name)
1801 if( !defined $directory->{"Encoding"} or
1802 $directory->{"Encoding"} eq 'UTF-8')
1804 Encode::from_to($directory_name, "utf8", $charset);
1807 $menu_name = $directory_name;
1811 $menu->{'PrepName'} = $menu_name;
1814 while ( defined $menu->{'entries'}[$i] )
1816 my $entry = $menu->{'entries'}[$i];
1817 if ( $entry->{'type'} eq 'desktop' )
1819 my $desktop = $entry->{desktop};
1820 my $name = $desktop->{'id'};
1821 my $desktop_name = get_loc_entry( $desktop, 'Name' );
1822 if ( defined $desktop_name )
1824 Encode::from_to( $desktop_name, "utf8", $charset )
1825 if !defined $desktop->{"Encoding"}
1826 || $desktop->{"Encoding"} eq 'UTF-8';
1827 $name = $desktop_name;
1829 $desktop->{'PrepName'} = $name;
1830 $entry->{'Name'} = $name;
1831 $entry->{'PrepName'} = $name;
1832 $desktop->{'PrepExec'} = prepare_exec( $desktop->{Exec}, $desktop );
1835 elsif ( $entry->{type} eq 'menu' )
1837 if ( preprocess_menu( $entry->{'menu'} ) )
1839 $entry->{'Name'} = $entry->{'menu'}{'Name'};
1840 $entry->{'PrepName'} = $entry->{'menu'}{'PrepName'};
1845 splice @{ $menu->{'entries'} }, $i, 1;
1850 warn "wrong menu entry type: $entry->{type}";
1851 exit 1 if $die_on_error;
1852 splice @{ $menu->{'entries'} }, $i, 1;
1856 $menu->{'entries'} = [
1858 $b->{'type'} cmp $a->{'type'}
1859 || $a->{'PrepName'} cmp $b->{'PrepName'}
1860 } @{ $menu->{'entries'} }
1865 while ( defined $menu->{'entries'}[$i] )
1867 my $entry = $menu->{'entries'}[$i];
1868 if (defined $prev_entry
1869 and $entry->{'type'} eq 'desktop'
1870 and $prev_entry->{'type'} eq 'desktop'
1871 and $prev_entry->{'PrepName'} eq $entry->{'PrepName'}
1872 and $prev_entry->{'desktop'}->{'PrepExec'} eq
1873 $entry->{'desktop'}->{'PrepExec'} )
1875 splice @{ $menu->{'entries'} }, $i, 1;
1879 $prev_entry = $entry;
1886 sub output_fvwm2_menu
1888 my ($menu, $toplevel, $path) = @_;
1890 $path = '' unless defined $path;
1891 $toplevel = 1 unless defined $toplevel;
1895 my $menu_name = $menu->{'PrepName'};
1896 my $menu_id = "$path-" . $menu->{'Name'};
1897 $menu_id =~ s/\s/_/g;
1898 $menu_id = $menu_prefix if $toplevel;
1899 foreach my $entry ( @{ $menu->{'entries'} } )
1901 if ( $entry->{type} eq 'menu' ) {
1902 $output .= output_fvwm2_menu( $entry->{'menu'}, 0, $menu_id );
1905 $output .= "DestroyMenu \"$menu_id\"\n";
1906 $output .= "AddToMenu \"$menu_id\" \"$dmicon{'fvwm_title'}$label$menu_name\" Title\n";
1908 if ($MENU_STYLE ne '')
1910 push @menus_for_style, $menu_id;
1913 foreach my $entry ( @{ $menu->{'entries'} } )
1915 if ( $entry->{type} eq 'desktop' )
1917 my $desktop = $entry->{desktop};
1918 my $name = $desktop->{'PrepName'};
1919 my $exec = $desktop->{'PrepExec'};
1920 $output .= "+ \"$dmicon{'fvwm_app'}$name\" Exec $exec\n";
1922 elsif ( $entry->{type} eq 'menu')
1924 my $name = $entry->{'menu'}{'PrepName'};
1925 my $id = "$menu_id-" . $entry->{'menu'}{'Name'};
1927 $output .= "+ \"$dmicon{'fvwm_folder'}$name\" Popup \"$id\"\n";
1931 warn "wrong menu entry type: $entry->{type}";
1936 if ("$menu_id" eq "$menu_prefix-System_Tools")
1938 $output .= "AddToMenu \"$menu_prefix-System_Tools\" " .
1939 "\"$dmicon{'fvwm_app'}Regenerate Applications Menu\" " .
1940 "FvwmForm FvwmForm-Desktop\n";
1947 my $menu_base='applications';
1948 # fixme, change more... $menu_base='settings';
1949 foreach my $dir ( split( /:/, $xdg_config_dirs ), "/etc/xdg" )
1951 check_file("$dir/menus/$menu_base.menu");
1952 if ( -f "$dir/menus/$menu_base.menu" ) {
1953 warn "Root Menu $dir/menus/applications.menu\n" if $verbose;
1954 return "$dir/menus/$menu_base.menu";
1965 return $ret unless check_app("kde-config");
1967 my @kde_xdgdata = split( /:/, `kde-config --path xdgdata-apps` );
1969 foreach (@kde_xdgdata)
1971 s/\/applications\/*\s*$//;
1974 foreach my $d (split( /:/, $xdg_data_dirs ),
1975 @kde_xdgdata, "/usr/share", "/opt/gnome/share")
1979 next if defined $used{$dir};
1980 next if check_file("$dir/applications") ne 'D';
1981 $ret .= ':' if $ret ne '';
1982 $ret .= "$dir/applications";
1987 foreach ( split( ':', $ret ) )
1989 warn "app dirs $_\n";
1995 sub get_desktop_dirs
1999 foreach my $dir ( split( /:/, $xdg_data_dirs ),
2000 qw(/usr/share /opt/kde3/share /opt/gnome/share) )
2002 next if defined $used{$dir};
2003 next if check_file("$dir/desktop-directories") ne 'D';
2004 $ret .= ':' if $ret ne '';
2005 $ret .= "$dir/desktop-directories";
2008 warn "desktop dirs $ret\n" if $verbose;
2012 sub get_KDE_legacy_dirs
2016 my @legacy_dirs = (qw(
2017 /etc/opt/kde3/share/applnk
2018 /opt/kde3/share/applnk
2022 if (check_app("kde-config"))
2024 push @legacy_dirs, reverse(split(/:/,`kde-config --path apps` ));
2027 foreach my $d ( @legacy_dirs )
2032 next if defined $used{$dir};
2033 next if check_file("$dir") ne 'D';
2037 warn "KDE legacy dirs @ret\n" if $verbose;
2041 sub prepare_language_keys
2043 my ($language) = @_;
2046 $language =~ s/\.[^@]*//; # remove .ENCODING
2048 if ( $language =~ /^([^_]*)_([^@]*)@(.*)$/)
2050 # LANG_COUNTRY@MODIFIER
2051 push @keys, $1 . '_' . $2 . '@' . $3;
2052 push @keys, $1 . '_' . $2;
2053 push @keys, $1 . '@' . $3;
2056 elsif ($language =~ /^([^_]*)_([^@]*)$/)
2059 push @keys, $1 . '_' . $2;
2062 elsif ($language =~ /^([^_]*)@(.*)$/)
2065 push @keys, $1 . '@' . $2;
2068 elsif ($language =~ /^([^_@]*)$/)
2077 # Fixme, remove unsupported options.
2081 A perl script which parses xdg menu definitions to build
2082 the corresponding fvwm menus. The script can also build
2083 Icon and MiniIcon styles for the desktop applications.
2087 --help show this help and exit
2088 --version show version and exit
2089 --install-prefix DIR install prefix of the desktop
2090 --desktop NAME desktop to build the menu for it:
2091 gnome-sys (default), gnome-user, gnome-redhat, gnome-madriva,
2093 --type NAME fvwm (default) or gtk for a FvwmGtk menu
2094 --fvwmgtk-alias NAME FvwmGtk module name, default is FvwmGtk
2095 --title NAME menu title, default depends on --desktop
2096 --name NAME menu name, default depends on --desktop
2097 --merge-user-menu merge the system menu with the user menu
2098 --enable-mini-icons enable mini-icons in menu
2099 --enable-tran-mini-icons enable mini-icons in menu and
2100 translation of foo.png icon names to foo.xpm
2101 --mini-icons-path DIR path of menus icons (relative to your
2102 ImagePath), default is 'mini/'
2103 --png-icons-path DIR path of .png icons, default is your ImagePath
2104 --tran-mini-icons-path DIR path of menus icons for translation
2105 --check-mini-icons PATH check if the mini icons are in PATH
2106 --icon-toptitle micon:law:place:sidepic:color mini-icon for the top
2107 title and sidepic for the top menu
2108 --icon-title micon:law:place:sidepic:color as above for sub menus
2109 --icon-folder micon:law:place mini-icons for folder item
2110 --icon-app micon:law:place mini-icon for applications item
2111 --wm-icons define menu icon names to use with wm-icons
2112 --enable-style build icons and mini-icons style
2113 --enable-tran-style as above with translation (for FvwmGtk menus)
2114 --icon-style micon:icon:law icons for style
2115 --icons-path DIR define the directory of the icons,
2116 the default is very good
2117 --tran-icons-path DIR similar to the above option.
2118 --check-icons PATH check if the icons are in the PATH
2119 --submenu-name-prefix NAME in general not useful
2120 --dir DIR use path as desktop menu description
2121 --destroy-type FLAG how to destroy menu, valid values:
2122 'yes', 'no', 'dynamic', the default depends on --type
2123 --xterm CMD complete terminal command to run applications
2124 in it, default is 'xterm -e'
2125 --lang NAME language, default is \$LANG
2126 --utf8 For desktop entries coded in UTF-8 (KDE2)
2127 --uniconv Use (un)iconv for UTF-8 translation
2128 --uniconv-exec uniconv or iconv (default)
2129 --menu-style name assign specified MenuStyle name to menus
2130 --[no]check-app [do not] check that apps are in your path
2131 --time-limit NUM limit script running time to NUM seconds
2132 --verbose display debug type info oni STDERR
2133 Short options are ok if not ambiguous: -h, -x, -icon-a.
2138 # Check if application binary is executable and reachable
2142 # If full path, dont use path, just check path
2143 if ( substr($app,0,1) eq '/' and -x $app )
2148 # Check if an application is in the path
2149 foreach (@PATH_DIRS)
2151 return 1 if -x "$_/$app";
2166 print "WARNING: Argument \"$arg\" obsolete. Ignored.\n";
2169 # compile-command: "perl fvwm-menu-desktop.in --enable-mini-icons --fvwm-icons"