bin/fvwm-menu-desktop.in

   1 #!@PERL@
   2
   3 # Modification History
   4
   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.
  21
  22 # - Change menu prefix from xdg-menu to FvwmMenu
  23 #
  24 # FIXME:
  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.
  41 #    modularisation.)
  42 # - I don't see the point to the path arguments.  I think they should
  43 #   be obsoleted.
  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?
  49
  50 # ---------------------------------------------------------------------------
  51 #  fvwm-menu-desktop
  52 #  See the man page fvwm-menu-desktop.1 for instructions.
  53 #
  54 #  Created on 22/07/1999 by Olivier Chapuis
  55 #
  56 #  Updated on 15/08/1999 by Mikhael Goikhman
  57 #
  58 #  Updated on 24/12/2010 by Dan Espen for xdg menus (see copyright below)
  59 # ---------------------------------------------------------------------------
  60 # COPYING
  61 #
  62 # The script is distributed by the same terms as fvwm itself.
  63 # See GNU General Public License for details.
  64 #
  65 #----------------------------------------------------------------------------
  66
  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>
  70 #
  71 # >> Copyright (c) 2003 SuSE Linux AG, Nuernberg, Germany. All rights reserved.
  72 # >>
  73 # >> Author: nadvornik@suse.cz
  74
  75 use version '5.0008';
  76 use strict;
  77 use warnings;
  78 use Getopt::Long;
  79 use Encode;
  80 use I18N::Langinfo qw(langinfo CODESET);
  81 use POSIX qw(locale_h);
  82 use Digest::MD5 qw(md5_hex);
  83 use XML::Parser;
  84
  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
  88
  89 my $version = '@VERSION@';
  90 my $menu_prefix='FvwmMenu';
  91 my $DefaultAppDirs;
  92 my $DefaultDirectoryDirs;
  93 my @KDELegacyDirs;
  94 my $desktop_name = 'fvwm2';
  95 my $language = '';
  96 my $charset = 'iso-8859-1';
  97 my $root_cmd;
  98 my $die_on_error = 0;
  99 my $verbose = 0;
 100
 101 my @language_keys;
 102
 103 #my @accessed_files;
 104 my $TERM_CMD = "xterm -e";
 105
 106
 107 my %Desktop_entries;
 108 my %Directory_entries;
 109
 110 my $root_menu;
 111 my $help;
 112
 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)
 117 my $ICONS_DIR = '';
 118 # For png icons
 119 my $PNG_ICONS = '';
 120 my $TRAN_MINI_ICONS = 'mini/';
 121 my $TRAN_ICONS = '';
 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
 126 # check icons
 127 my $check_icons = "";
 128 my $check_mini_icons = "";
 129 my @check_icons_path = ();
 130 my @check_mini_icons_path = ();
 131 my %DI;
 132 my %dmicon;
 133 # Menu Style option
 134 my $MENU_STYLE = "";
 135 my @menus_for_style = ();
 136 # default for style
 137
 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 = '';
 143
 144 warn "invoked with args @ARGV\n" if $verbose;
 145
 146 GetOptions(
 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,
 184
 185            "su_gui"  => \$root_cmd,
 186            "verbose" => \$verbose
 187 );
 188
 189 icon_init();
 190
 191 $DefaultAppDirs = get_app_dirs();
 192 $DefaultDirectoryDirs = get_desktop_dirs();
 193
 194 $root_menu = get_root_menu();
 195
 196 @KDELegacyDirs = get_KDE_legacy_dirs();
 197
 198 $charset = langinfo(CODESET);
 199 $language = setlocale(LC_MESSAGES);
 200
 201 if (! defined $root_cmd )
 202 {
 203     foreach (qw(gnomesu kdesu xdg_menu_su))
 204     {
 205             if (check_app($_))
 206         {
 207                 $root_cmd = $_;
 208                 last;
 209             }
 210     }
 211 }
 212
 213 if ($verbose)
 214 {
 215     warn qq|
 216         DEBUG: root menu is $root_menu
 217     DEBUG: charset is $charset.
 218         DEBUG: language is $language.
 219         DEBUG: root-cmd is $root_cmd.|;
 220 }
 221
 222 @language_keys = prepare_language_keys($language);
 223
 224 unless (-f $root_menu)
 225 {
 226     warn "ERROR: Can't find root menu file.\n";
 227     exit 1;
 228 }
 229
 230 my $tree = read_menu($root_menu);
 231
 232 merge_menus($tree);
 233 move_menus($tree);
 234
 235 my $menu = interpret_root($tree, '');
 236
 237 remove_allocated($menu);
 238 preprocess_menu($menu);
 239 remove_empty_menus($menu);
 240
 241 my $output = output_fvwm2_menu($menu);
 242 print $output;
 243
 244 # output the menu style
 245 if ($MENU_STYLE ne "")
 246 {
 247     foreach (@menus_for_style)
 248     {
 249             print qq|ChangeMenuStyle "$MENU_STYLE" "$_"\n|;
 250     }
 251 }
 252
 253 exit 0;
 254
 255 # Set DI to list of icons to use:
 256 sub icon_init
 257   {
 258     my @list=();
 259     my %law;
 260     my %place;
 261     my %spic;
 262     my %scolor;
 263     my $j = "";
 264     my $l = "";
 265     my $tmp_icon ="";
 266
 267     if ($wm_icons) {
 268       $MINI_ICONS = 1;
 269       $MINI_ICONS_DIR = "";
 270       $DI{"fvwm_toptitle"} = "menu/folder-open.xpm:ow";
 271       $DI{"fvwm_title"}    = "menu/folder-open.xpm:ow";
 272       $DI{"fvwm_folder"}   = "menu/folder.xpm:ow";
 273       $DI{"fvwm_app"}      = "menu/utility.xpm:ow";
 274     }
 275
 276     if ($fvwm_icons) {
 277       $MINI_ICONS = 1;
 278       $MINI_ICONS_DIR = "";
 279       $DI{"fvwm_toptitle"} = "mini.fvwm.xpm::%";
 280       $DI{"fvwm_title"}    = "mini.folder.xpm::%";
 281       $DI{"fvwm_folder"}   = "mini.ofolder.xpm::%";
 282       $DI{"fvwm_app"}      = "mini.cat.xpm::%";
 283     }
 284
 285     foreach my $i (keys(%DI)) {
 286       @list = split(':',$DI{$i});
 287       $dmicon{$i} = $list[0];   # "default" mini-icon
 288       $law{$i}    = $list[1];   # default law
 289       $place{$i}  = $list[2];   # default position
 290       $spic{$i}   = $list[3];   # sidepic icon
 291       $scolor{$i} = $list[4];   # color for sidepic
 292       $DI{$i} = '';
 293     }
 294
 295     if ($TRAN) {
 296       $MINI_ICONS = 1;
 297     }
 298
 299     if ($MINI_ICONS_DIR ne 'mini/' or $ICONS_DIR ne '') {
 300       if ($MINI_ICONS_DIR ne '') {
 301         $MINI_ICONS_DIR =~ s/\/*$/\//;
 302       }
 303
 304       if ($ICONS_DIR eq '') {
 305         $ICONS_DIR = up_directory($MINI_ICONS_DIR);
 306       } elsif ($ICONS_DIR eq 'inpath') {
 307         $ICONS_DIR = '';
 308       } else {
 309         $ICONS_DIR =~ s/\/*$/\// if $MINI_ICONS_DIR ne '';
 310       }
 311     }
 312
 313     if ($TRAN_MINI_ICONS ne 'mini/' or $TRAN_ICONS ne '') {
 314       if ($TRAN_MINI_ICONS ne '') {
 315         $TRAN_MINI_ICONS =~ s/\/*$/\//;
 316       }
 317
 318       if ($TRAN_ICONS eq '') {
 319         $TRAN_ICONS = up_directory($TRAN_MINI_ICONS);
 320       } elsif ($TRAN_ICONS eq 'inpath') {
 321         $TRAN_ICONS = '';
 322       } else {
 323         $TRAN_ICONS =~ s/\/*$/\// if $TRAN_ICONS ne '';
 324       }
 325     }
 326
 327     $PNG_ICONS =~  s/\/*$/\// if $PNG_ICONS ne '';
 328
 329     # init default mini-icons, law, place, sidepic, color
 330     foreach my $i (qw(fvwm_app fvwm_folder fvwm_title fvwm_toptitle)) {
 331       warn "DEBUG: foreach $i.\n" if $verbose; # dje debug
 332       # With the mini-icons-tran options we "use" gtk default
 333       if ($TRAN) {
 334         $j = substr($i,index($i,'_'));
 335         $j = "gtk$j";
 336         $law{$i} = $law{$j};
 337         $tmp_icon  = $dmicon{$j};
 338         $tmp_icon  =~ s/\.png$/\.xpm/;
 339         $dmicon{$i} = "$TRAN_MINI_ICONS$tmp_icon";
 340       } else {
 341         $dmicon{$i} = "$MINI_ICONS_DIR$dmicon{$i}";
 342       }
 343
 344       if ($verbose) {
 345         while (my ($key,$value) = each %dmicon) {
 346           warn "INTERMEDIATE icons to use $key -> $value.\n";
 347         }
 348       }
 349       @list = split(':',$DI{$i});
 350       $l = @list;
 351       while ($l <= 5) {
 352         push(@list,'');
 353         ++$l;
 354       }
 355       $law{$i}     = $list[1] if ($list[1] eq 'no' or $list[1] eq 'ow'
 356                                   or $list[1] eq 're' or $list[1] eq 'dh');
 357       $dmicon{$i}  = "$MINI_ICONS_DIR$list[0]" if $list[0] ne '';
 358       $place{$i}   = '*' if $list[2] eq 'up';
 359       $dmicon{$i}  = "$place{$i}$dmicon{$i}$place{$i}";
 360       $dmicon{$i}  = '' if $law{$i} eq 'no' or $MINI_ICONS == 0;
 361
 362       if ($list[3] ne '') {
 363         $spic{$i} = "\@$list[3]\@";
 364       } else {
 365         $spic{$i} = '';
 366       }
 367
 368       if ($list[4] ne '' and $list[3] ne '') {
 369         $scolor{$i} = "\^$list[4]\^";
 370       } else {
 371         $scolor{$i} = '';
 372       }
 373
 374       if ($check_mini_icons ne "") {
 375         @check_mini_icons_path = split(":", $check_mini_icons);
 376       }
 377
 378       if ($check_icons ne "") {
 379         @check_icons_path = split(":", $check_icons);
 380       }
 381
 382
 383
 384       if ($verbose) {
 385         while (my ($key, $value) = each %dmicon) {
 386           warn "icons to use $key -> $value.\n";
 387         }
 388       }
 389     }
 390   }
 391
 392 # Compute cd ..
 393 sub up_directory
 394 {
 395         my($dir) = @_;
 396
 397         if ($dir eq '')
 398     {
 399         return '../';
 400     }
 401
 402         chop($dir);
 403
 404     if ($dir !~ /\//)
 405     {
 406         return '';
 407     }
 408         $dir = substr($dir, 0, rindex($dir, '/') + 1);
 409
 410         return $dir;
 411 }
 412
 413 sub check_file
 414 {
 415     my ($file) = @_;
 416     unless (-e $file)
 417     {
 418         return '';
 419     }
 420
 421     if (-d $file)
 422     {
 423         return 'D';
 424     }
 425
 426     return 'F';
 427 }
 428
 429 sub scan_AppDir
 430 {
 431     my ($pool, $dir, $topdir) = @_;
 432
 433     check_file($dir);
 434
 435     $topdir = $dir unless defined $topdir;
 436
 437     return if check_file($dir) ne 'D';
 438
 439     opendir( my $dir_fh, $dir ) or return;
 440     foreach my $entry ( readdir($dir_fh) )
 441     {
 442         if (-f "$dir/$entry" and $entry =~ /\.desktop$/)
 443         {
 444             read_desktop_entry($pool, "$dir/$entry", $topdir);
 445         }
 446         elsif (-d "$dir/$entry" and $entry !~ /^\.{1,2}$/
 447                 and $entry ne '.hidden')
 448         {
 449             scan_AppDir($pool, "$dir/$entry", $topdir);
 450         }
 451     }
 452     closedir $dir_fh;
 453 }
 454
 455 sub scan_DirectoryDir
 456 {
 457     my ($pool, $dir, $topdir) = @_;
 458
 459     check_file($dir);
 460     $topdir = $dir unless defined $topdir;
 461
 462     opendir( my $dir_fh, $dir ) or return;
 463     foreach my $entry (readdir($dir_fh))
 464     {
 465         if (-f "$dir/$entry" and $entry =~ /\.directory$/)
 466         {
 467             read_directory_entry( $pool, "$dir/$entry", $topdir );
 468         }
 469         elsif (-d "$dir/$entry" and $entry !~ /^\.{1,2}$/
 470                 and $entry ne '.hidden')
 471         {
 472             scan_DirectoryDir($pool, "$dir/$entry", $topdir);
 473         }
 474     }
 475     closedir $dir_fh;
 476 }
 477
 478 sub read_directory_entry
 479 {
 480     my ($pool, $file, $topdir) = @_;
 481
 482     unless (defined $Directory_entries{$file})
 483     {
 484         check_file($file);
 485
 486         if ($verbose)
 487         {
 488                 warn "Read directory entry, opening file $file.\n";
 489             }
 490         open( my $file_fh, "<", $file ) or return;
 491         my $in_desktop_entry = 0;
 492         my %entry;
 493         while (<$file_fh>)
 494         {
 495             if (/^\[/)
 496             {
 497                 if (/^\[Desktop Entry\]/)
 498                 {
 499                     $in_desktop_entry = 1;
 500                 }
 501                 elsif (/^\[.*\]/)
 502                 {
 503                     $in_desktop_entry = 0;
 504                 }
 505             }
 506             elsif ($in_desktop_entry and /^([^=]*)=([^[:cntrl:]]*)/)
 507             {
 508                 $entry{$1} = $2;
 509             }
 510         }
 511         close($file_fh);
 512
 513         my $id = $file;
 514         $id =~ s/^$topdir//;
 515         $id =~ s/^\/*//;
 516         $id =~ s/\//-/g;
 517         $entry{'id'} = $id;
 518         $Directory_entries{$file} = \%entry;
 519     }
 520     my $entry = $Directory_entries{$file};
 521     $pool->{'Directory_entries'}{ $entry->{'id'} } = $entry;
 522 }
 523
 524 sub check_show_in
 525 {
 526     my ($entry) = @_;
 527
 528     return 1 unless defined $entry;
 529
 530     my (%OnlyShowIn, %NotShowIn);
 531
 532     if (defined $entry->{'OnlyShowIn'})
 533     {
 534         foreach my $showin (split /;/, $entry->{'OnlyShowIn'})
 535         {
 536             $OnlyShowIn{$showin} = 1;
 537         }
 538
 539         return 0 unless defined $OnlyShowIn{$desktop_name};
 540     }
 541
 542     if (defined $entry->{'NotShowIn'})
 543     {
 544         foreach my $showin (split /;/, $entry->{'NotShowIn'})
 545         {
 546             $NotShowIn{$showin} = 1;
 547         }
 548
 549         return 0 if defined $NotShowIn{$desktop_name};
 550     }
 551
 552     return 1;
 553 }
 554
 555 sub read_desktop_entry
 556 {
 557   my ($pool, $file, $topdir) = @_;
 558
 559   unless (defined $Desktop_entries{$file}) {
 560     check_file($file);
 561     if ($verbose) {
 562       warn "Read desktop entry, opening file $file.\n";
 563     }
 564     open( my $file_fh, "<", $file ) or return;
 565
 566     my $in_desktop_entry = 0;
 567     my %entry;
 568     while (<$file_fh>) {
 569       if (/^\[/) {
 570         if (/^\[Desktop Entry\]/) {
 571           $in_desktop_entry = 1;
 572         } elsif (/^\[.*\]/) {
 573           $in_desktop_entry = 0;
 574           }
 575       } elsif ($in_desktop_entry && /^([^=]*)=([^[:cntrl:]]*)/) {
 576         $entry{$1} = $2;
 577       }
 578     }
 579     close($file_fh);
 580
 581     my $id = $file;
 582     $id =~ s/^$topdir//;
 583     $id =~ s/^\/*//;
 584     $id =~ s/\//-/g;
 585     $entry{'id'} = $id;
 586
 587     $entry{'refcount'} = 0;
 588     $Desktop_entries{$file} = \%entry;
 589   }
 590
 591   my $entry = $Desktop_entries{$file};
 592
 593   if (! defined $entry->{'Name'}) { # dje debug
 594     warn "Name is not defined\n";
 595   }
 596
 597   return unless defined $entry->{'Name'};
 598   return unless defined $entry->{'Exec'};
 599
 600   if (defined $entry->{'Hidden'} and $entry->{'Hidden'} eq 'true') {
 601     return;
 602   }
 603
 604   #FIXME, an option for this would be good
 605
 606   if (defined $entry->{'NoDisplay'} and  $entry->{'NoDisplay'} eq 'true') {
 607     return;
 608   }
 609
 610   return unless check_show_in($entry);
 611
 612   if (defined $entry->{'NotShowIn'} and
 613       $entry->{'NotShowIn'} eq $desktop_name) {
 614     return;
 615   }
 616
 617   if (defined $pool and defined $entry->{'Categories'}) {
 618     foreach my $category (split /;/, $entry->{'Categories'}) {
 619       $pool->{'Categories'}{$category} = []
 620         unless defined $pool->{'Categories'}{$category};
 621       push @{ $pool->{'Categories'}{$category} }, $entry;
 622     }
 623     $pool->{'Desktop_entries'}{ $entry->{'id'} } = $entry;
 624   }
 625   return $entry;
 626 }
 627
 628 sub read_desktop_entries
 629 {
 630     my ($directory_paths, $desktop_paths) = @_;
 631     my $pool = {
 632         'Desktop_entries'   => {},
 633         'Categories'        => {},
 634         'Directory_entries' => {},
 635         'Directory_paths'   => $directory_paths,
 636         'Desktop_paths'     => $desktop_paths
 637     };
 638
 639     foreach my $dir (split /:/, $directory_paths)
 640     {
 641         next if $dir =~ /^\s*$/;
 642         scan_DirectoryDir( $pool, $dir );
 643     }
 644
 645     foreach my $dir (split /:/, $desktop_paths)
 646     {
 647         next if $dir =~ /^\s*$/;
 648         scan_AppDir( $pool, $dir );
 649     }
 650
 651     return $pool;
 652 }
 653
 654 sub get_directory_entry
 655 {
 656     my ($entry, $pool) = @_;
 657     return $pool->{'Directory_entries'}{$entry};
 658 }
 659
 660 sub interpret_Include
 661 {
 662     my ( $tree, $entries, $pool ) = @_;
 663     my %exist;
 664     my @list = interpret_entry_node( $tree, 'Or', $pool );
 665     foreach my $e (@$entries)
 666     {
 667         if ( $e->{type} eq 'desktop' )
 668         {
 669             $exist{ $e->{desktop} } = 1;
 670         }
 671     }
 672
 673     foreach my $entry (@list)
 674     {
 675         next if $exist{$entry};
 676         push @$entries, { type => 'desktop', desktop => $entry };
 677         $entry->{'refcount'}++;
 678         $exist{$entry} = 1;
 679     }
 680 }
 681
 682 sub interpret_Exclude
 683 {
 684     my ( $tree, $entries, $pool ) = @_;
 685     my @list = interpret_entry_node( $tree, 'Or', $pool );
 686     foreach my $entry (@list)
 687     {
 688         my $i = 0;
 689         while ( defined $entries->[$i] )
 690         {
 691             my $exist = $entries->[$i];
 692             if ($exist->{type} eq 'desktop' and
 693                 $exist->{desktop} eq $entry )
 694             {
 695                 splice @$entries, $i, 1;
 696                 $entry->{'refcount'}--;
 697             }
 698             else
 699             {
 700                 $i++;
 701             }
 702         }
 703     }
 704 }
 705
 706 sub interpret_entry_node
 707 {
 708     my ( $tree, $node, $pool ) = @_;
 709     my $i = 0;
 710     $i++ if ( ref( $tree->[$i] ) eq 'HASH' );
 711     my @subtree;
 712     while (defined $tree->[$i])
 713     {
 714         if ($tree->[$i] eq 'Filename')
 715         {
 716             $i++;
 717             if (ref( $tree->[$i][0] ) eq 'HASH' and $tree->[$i][1] eq '0')
 718             {
 719                 my $entry = $tree->[$i][2];
 720                 if (defined $pool->{'Desktop_entries'}{$entry})
 721                 {
 722                     push @subtree, [ $pool->{'Desktop_entries'}{$entry} ];
 723                 }
 724                 else
 725                 {
 726                     push @subtree, [];
 727                 }
 728             }
 729             else
 730             {
 731                 warn "Filename\n";
 732                 exit 1 if $die_on_error;
 733             }
 734             $i++;
 735         }
 736         elsif ($tree->[$i] eq 'Category')
 737         {
 738             $i++;
 739             if (ref( $tree->[$i][0] ) eq 'HASH' and $tree->[$i][1] eq '0')
 740             {
 741                 my $category = $tree->[$i][2];
 742                 if (defined $pool->{'Categories'}{$category})
 743                 {
 744                     push @subtree, $pool->{'Categories'}{$category};
 745                 }
 746                 else
 747                 {
 748                     push @subtree, [];
 749                 }
 750             }
 751             else
 752             {
 753                 warn "Category\n";
 754                 exit 1 if $die_on_error;
 755             }
 756             $i++;
 757         }
 758         elsif ($tree->[$i] eq 'All')
 759         {
 760             $i++;
 761             if (values %{ $pool->{'Desktop_entries'} } > 0)
 762             {
 763                 push @subtree, [ values %{ $pool->{'Desktop_entries'} } ];
 764             }
 765             else
 766             {
 767                 push @subtree, [];
 768             }
 769             $i++;
 770         }
 771         elsif ($tree->[$i] eq '0')
 772         {
 773             $i++;
 774             $i++;
 775         }
 776         else
 777         {
 778             my @res = interpret_entry_node(
 779                 $tree->[ $i + 1 ], $tree->[$i], $pool
 780             );
 781
 782             push @subtree, \@res;
 783             $i++;
 784             $i++;
 785         }
 786     }
 787
 788     if ($node eq 'Or')
 789     {
 790         my %used;
 791         my @res;
 792         foreach my $st (@subtree)
 793         {
 794             foreach my $entry (@$st)
 795             {
 796                 if (!defined $used{$entry})
 797                 {
 798                     push @res, $entry;
 799                     $used{$entry} = 1;
 800                 }
 801             }
 802         }
 803         return @res;
 804     }
 805     elsif ($node eq 'And')
 806     {
 807         my %used;
 808         my @res;
 809         my $cnt     = @subtree;
 810         my $min     = @{ $subtree[0] };
 811         my $min_idx = 0;
 812         my $idx     = 0;
 813         foreach my $st (@subtree)
 814         {
 815             my $num = @$st;
 816             if ($num < $min)
 817             {
 818                 $min     = $num;
 819                 $min_idx = $idx;
 820             }
 821
 822             my %dupes;
 823             foreach my $entry (@$st)
 824             {
 825                 next if $dupes{$entry};
 826                 $dupes{$entry} = 1;
 827
 828                 if (!defined $used{$entry})
 829                 {
 830                     $used{$entry} = 1;
 831                 }
 832                 else
 833                 {
 834                     $used{$entry}++;
 835                 }
 836             }
 837             $idx++;
 838         }
 839
 840         return () if $cnt == 0;
 841
 842         foreach my $entry (@{ $subtree[$min_idx] })
 843         {
 844             push @res, $entry if $used{$entry} == $cnt;
 845         }
 846
 847         return @res;
 848     }
 849     elsif ($node eq 'Not')
 850     {
 851         my %used;
 852         my @res;
 853
 854         my $cnt = @subtree;
 855         foreach my $st (@subtree) {
 856             foreach my $entry (@$st) {
 857                 $used{$entry} = 1;
 858             }
 859         }
 860         return if $cnt == 0;
 861         foreach my $entry (values %{ $pool->{'Desktop_entries'} })
 862         {
 863             push @res, $entry if !defined $used{$entry};
 864         }
 865
 866         return @res;
 867     }
 868     else
 869     {
 870         warn "Can't use '$node' inside <Include> or <Exclude>\n";
 871         exit 1 if $die_on_error;
 872         return ();
 873     }
 874 }
 875
 876 sub interpret_root
 877 {
 878     my ($tree, $topdir) = @_;
 879
 880     if ($tree->[0] eq 'Menu')
 881     {
 882         return interpret_menu( $tree->[1] );
 883     }
 884     else
 885     {
 886         warn "No toplevel Menu\n";
 887         exit 1 if $die_on_error;
 888         return;
 889     }
 890 }
 891
 892 sub interpret_menu
 893 {
 894     my ($tree, $directory_paths, $desktop_paths) = @_;
 895
 896     $directory_paths = '' unless defined $directory_paths;
 897     $desktop_paths   = '' unless defined $desktop_paths;
 898
 899     my %menu = (
 900         'entries'         => [],
 901         'OnlyUnallocated' => 0,
 902         'DontShowIfEmpty' => 0,
 903         'Deleted'         => 0
 904     );
 905
 906     my $i = 0;
 907
 908     $i++ if ref $tree->[$i] eq 'HASH';
 909
 910     while (defined $tree->[$i])
 911     {
 912         if ($tree->[$i] eq 'AppDir')
 913         {
 914             if (ref( $tree->[ $i + 1 ][0] ) eq 'HASH'
 915                 and $tree->[ $i + 1 ][1] eq '0')
 916             {
 917                 $desktop_paths .= ':' . $tree->[ $i + 1 ][2];
 918                 splice @$tree, $i, 2;
 919             }
 920             else
 921             {
 922                 warn "wrong AppDir\n";
 923                 exit 1 if $die_on_error;
 924                 $i++;
 925                 $i++;
 926             }
 927         }
 928         elsif ($tree->[$i] eq 'DefaultAppDirs')
 929         {
 930             $desktop_paths .= ':' . $DefaultAppDirs;
 931             splice @$tree, $i, 2;
 932         }
 933         elsif ($tree->[$i] eq 'DirectoryDir')
 934         {
 935             if (ref( $tree->[ $i + 1 ][0]) eq 'HASH'
 936                 and $tree->[ $i + 1 ][1] eq '0')
 937             {
 938                 $directory_paths .= ':' . $tree->[ $i + 1 ][2];
 939                 splice @$tree, $i, 2;
 940             }
 941             else
 942             {
 943                 warn "wrong DirectoryDir\n";
 944                 exit 1 if $die_on_error;
 945                 $i++;
 946                 $i++;
 947             }
 948         }
 949         elsif ($tree->[$i] eq 'DefaultDirectoryDirs')
 950         {
 951             $directory_paths .= ':' . $DefaultDirectoryDirs;
 952             splice @$tree, $i, 2;
 953         }
 954         else
 955         {
 956             $i++;
 957             $i++;
 958         }
 959     }
 960
 961     $menu{directory_paths} = $directory_paths;
 962     $menu{desktop_paths}   = $desktop_paths;
 963
 964     my $pool = read_desktop_entries( $directory_paths, $desktop_paths );
 965
 966     $i = 0;
 967     $i++ if ref $tree->[$i] eq 'HASH';
 968
 969     while (defined $tree->[$i])
 970     {
 971         if ($tree->[$i] eq 'Menu')
 972         {
 973             $i++;
 974             my $submenu = interpret_menu(
 975                 $tree->[$i], $directory_paths, $desktop_paths
 976             );
 977
 978             push( @{ $menu{'entries'} },
 979                     { type => 'menu', menu => $submenu }
 980             );
 981             $i++;
 982         }
 983         elsif ($tree->[$i] eq 'Name')
 984         {
 985             $i++;
 986             if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0')
 987             {
 988                 $menu{'Name'} = $tree->[$i][2];
 989                 exit 1 if $die_on_error;
 990             }
 991             $i++;
 992         }
 993         elsif ($tree->[$i] eq 'Directory')
 994         {
 995             $i++;
 996             if (ref( $tree->[$i][0] ) eq 'HASH' and $tree->[$i][1] eq '0')
 997             {
 998                 $menu{'Directory'} = get_directory_entry(
 999                     $tree->[$i][2], $pool
1000                 );
1001             }
1002             else
1003             {
1004                 warn "wrong Directory\n";
1005                 exit 1 if $die_on_error;
1006             }
1007             $i++;
1008         }
1009         elsif ($tree->[$i] eq 'OnlyUnallocated')
1010         {
1011             $menu{'OnlyUnallocated'} = 1;
1012             $i++;
1013             $i++;
1014         }
1015         elsif ($tree->[$i] eq 'DontShowIfEmpty')
1016         {
1017             $menu{'DontShowIfEmpty'} = 1;
1018             $i++;
1019             $i++;
1020         }
1021         elsif ($tree->[$i] eq 'Deleted')
1022         {
1023             $menu{'Deleted'} = 1;
1024             $i++;
1025             $i++;
1026         }
1027         elsif ($tree->[$i] eq 'NotDeleted')
1028         {
1029             $menu{'Deleted'} = 0;
1030             $i++;
1031             $i++;
1032         }
1033         elsif ($tree->[$i] eq 'Include')
1034         {
1035             $i++;
1036             interpret_Include($tree->[$i], $menu{'entries'}, $pool);
1037             $i++;
1038         }
1039         elsif ($tree->[$i] eq 'Exclude')
1040         {
1041             $i++;
1042             interpret_Exclude($tree->[$i], $menu{'entries'}, $pool);
1043             $i++;
1044         }
1045         elsif ($tree->[$i] eq '0')
1046         {
1047             $i++;
1048             if ($tree->[$i] !~ /^\s*$/)
1049             {
1050                 print STDERR "skip '$tree->[$i]'\n";
1051                 exit 1 if $die_on_error;
1052             }
1053             $i++;
1054         }
1055         else
1056         {
1057             warn "Unknown '$tree->[$i]':\n";
1058             $i++;
1059             warn "        '@{$tree->[$i]}'\n";
1060             $i++;
1061             exit 1 if $die_on_error;
1062         }
1063     }
1064
1065     return \%menu;
1066 }
1067
1068 sub read_menu
1069 {
1070     my ($file, $basedir) = @_;
1071
1072     if ($file !~ /^\// and defined $basedir)
1073     {
1074         $file = "$basedir/$file";
1075     }
1076
1077     unless (defined $basedir)
1078     {
1079         $basedir = $file;
1080         $basedir =~ s/\/[^\/]*$//;
1081     }
1082
1083     unless (check_file($file))
1084     {
1085         warn "WARNING: '$file' does not exist\n";
1086         return [ 'Menu', [ {} ] ];
1087     }
1088
1089     warn "reading '$file'\n" if $verbose;
1090
1091     my $parser = XML::Parser->new(Style => 'Tree');
1092     my $tree = $parser->parsefile($file);
1093
1094     my $DefaultMergeDir = $file;
1095     $DefaultMergeDir =~ s/^.*\///;
1096     $DefaultMergeDir =~ s/\.menu$/-merged/;
1097
1098     read_includes($tree, $basedir, $DefaultMergeDir);
1099
1100     return $tree;
1101 }
1102
1103 sub read_menu_dir
1104 {
1105     my ($dir, $basedir) = @_;
1106
1107     my @out;
1108
1109     if ($dir !~ /^\// and defined $basedir)
1110     {
1111         $dir = "$basedir/$dir";
1112     }
1113
1114     if (check_file($dir) ne 'D')
1115     {
1116         return [];
1117     }
1118
1119     opendir( my $dir_fh, $dir );
1120     foreach my $entry (readdir($dir_fh))
1121     {
1122
1123         if (-f "$dir/$entry" and $entry =~ /\.menu$/)
1124         {
1125             my $menu = read_menu("$dir/$entry");
1126             $menu = remove_toplevel_Menu($menu);
1127             push @out, @$menu;
1128         }
1129     }
1130     closedir $dir_fh;
1131
1132     return \@out;
1133 }
1134
1135 sub quote_xml
1136 {
1137     my ($txt) = @_;
1138
1139     $txt =~ s/&/&amp;/g;
1140     $txt =~ s/</&lt;/g;
1141     $txt =~ s/>/&gt;/g;
1142     return $txt;
1143 }
1144
1145 sub read_legacy_dir
1146 {
1147     my ($dir, $basedir) = @_;
1148     my $out;
1149
1150     $dir =~ s/\/*$//;
1151
1152     $basedir = $dir unless defined $basedir;
1153
1154     return "" if check_file($dir) ne 'D';
1155
1156     $out = "<Menu>\n";
1157
1158     if ($dir eq $basedir)
1159     {
1160         my $xmldir = quote_xml($dir);
1161
1162         $out .= "<AppDir>$xmldir</AppDir>\n";
1163         $out .= "<DirectoryDir>$xmldir</DirectoryDir>\n";
1164     }
1165     else
1166     {
1167         my $name = $dir;
1168         $name =~ s/\/*$//;
1169         $name =~ s/^.*\///;
1170
1171         $name = quote_xml($name);
1172         $out .= "<Name>$name</Name>\n";
1173     }
1174
1175     if (-f "$dir/.directory")
1176     {
1177         my $dir_id = "$dir/.directory";
1178         $dir_id =~ s/^$basedir//;
1179         $dir_id =~ s/^\///;
1180         $dir_id = quote_xml($dir_id);
1181
1182         $out .= "<Directory>$dir_id</Directory>\n";
1183     }
1184
1185     if (opendir(my $dir_fh, $dir))
1186     {
1187         foreach my $entry (readdir($dir_fh))
1188         {
1189             if (-f "$dir/$entry" and $entry =~ /\.desktop$/)
1190             {
1191                 my $id = "$dir/$entry";
1192                 $id =~ s/^$basedir//;
1193                 $id =~ s/^\///;
1194                 $id =~ s/\//-/g;
1195                 $id = quote_xml($id);
1196
1197                 my $desktop = read_desktop_entry(
1198                     undef, "$dir/$entry", $basedir
1199                 );
1200
1201                 $out .= "<Include><Filename>$id</Filename></Include>\n"
1202                     unless defined $desktop->{'Categories'};
1203             }
1204             elsif (-d "$dir/$entry" and $entry !~ /^\.{1,2}$/ and
1205                     $entry ne '.hidden')
1206             {
1207                 $out .= read_legacy_dir( "$dir/$entry", $basedir );
1208             }
1209         }
1210         closedir $dir_fh;
1211     }
1212
1213     $out .= "</Menu>\n";
1214     return $out;
1215 }
1216
1217 sub remove_toplevel_Menu
1218 {
1219     my ($tree) = @_;
1220
1221     if ($tree->[0] eq 'Menu')
1222     {
1223         shift @{ $tree->[1] } if ref $tree->[1][0] eq 'HASH';
1224         return $tree->[1];
1225     }
1226     else
1227     {
1228         warn "No toplevel Menu\n";
1229         exit 1 if $die_on_error;
1230         return;
1231     }
1232 }
1233
1234 sub read_includes
1235 {
1236     my ($tree, $basedir, $DefaultMergeDir) = @_;
1237     my $i = 0;
1238     $i++ if ref $tree->[$i] eq 'HASH';
1239
1240     while (defined $tree->[$i])
1241     {
1242         if ($tree->[$i] eq 'MergeFile')
1243         {
1244             if (ref( $tree->[ $i + 1 ][0]) eq 'HASH'
1245                 and $tree->[ $i + 1 ][1] eq '0')
1246             {
1247                 my $add_tree = read_menu(
1248                     $tree->[ $i + 1 ][2], $basedir
1249                 );
1250                 $add_tree = remove_toplevel_Menu($add_tree);
1251
1252                 splice @$tree, $i, 2, @$add_tree;
1253             }
1254             else
1255             {
1256                 warn "wrong MergeFile\n";
1257                 exit 1 if $die_on_error;
1258                 $i++;
1259                 $i++;
1260             }
1261         }
1262         elsif ($tree->[$i] eq 'MergeDir')
1263         {
1264             if (ref( $tree->[ $i + 1 ][0] ) eq 'HASH'
1265                 and $tree->[ $i + 1 ][1] eq '0')
1266             {
1267                 my $add_tree = read_menu_dir( $tree->[ $i + 1 ][2], $basedir );
1268                 splice @$tree, $i, 2, @$add_tree;
1269             }
1270             else
1271             {
1272                 warn "wrong MergeFile\n";
1273                 exit 1 if $die_on_error;
1274                 $i++;
1275                 $i++;
1276             }
1277         }
1278         elsif ($tree->[$i] eq 'DefaultMergeDirs')
1279         {
1280             my $add_tree = read_menu_dir( $DefaultMergeDir, $basedir );
1281             splice @$tree, $i, 2, @$add_tree;
1282         }
1283         elsif ($tree->[$i] eq 'LegacyDir')
1284         {
1285             if (ref( $tree->[ $i + 1 ][0] ) eq 'HASH'
1286                 and $tree->[ $i + 1 ][1] eq '0')
1287             {
1288                 if (-d $tree->[ $i + 1 ][2])
1289                 {
1290                     my $xml = read_legacy_dir( $tree->[ $i + 1 ][2] );
1291                     warn "reading legacy directory '" . $tree->[ $i + 1 ][2] .
1292                         "'\n" if $verbose;
1293
1294                     my $parser = XML::Parser->new(Style => 'Tree');
1295                     my $add_tree = $parser->parse($xml);
1296                     $add_tree = remove_toplevel_Menu($add_tree);
1297                     splice @$tree, $i, 2, @$add_tree;
1298                 }
1299                 else
1300                 {
1301                     warn "legacy directory '"
1302                       . $tree->[ $i + 1 ][2]
1303                       . "' not found\n"
1304                       if $verbose;
1305                     splice @$tree, $i, 2, ();
1306                 }
1307             }
1308             else
1309             {
1310                 warn "wrong LegacyDir\n";
1311                 exit 1 if $die_on_error;
1312                 $i++;
1313                 $i++;
1314             }
1315         }
1316         elsif ($tree->[$i] eq 'KDELegacyDirs')
1317         {
1318             my @out;
1319             foreach my $dir (@KDELegacyDirs)
1320             {
1321                 my $xml = read_legacy_dir($dir);
1322                 warn "reading legacy directory '$dir'\n" if $verbose;
1323
1324                 my $parser = new XML::Parser( Style => 'Tree' );
1325                 my $add_tree = $parser->parse($xml);
1326                 $add_tree = remove_toplevel_Menu($add_tree);
1327                 push @out, @$add_tree;
1328             }
1329             splice @$tree, $i, 2, @out;
1330         }
1331         elsif ($tree->[$i] eq 'Menu')
1332         {
1333             $i++;
1334             read_includes( $tree->[$i], $basedir, $DefaultMergeDir );
1335             $i++;
1336         }
1337         else
1338         {
1339             $i++;
1340             $i++;
1341         }
1342     }
1343 }
1344
1345 sub get_menu_name
1346 {
1347     my ($tree) = @_;
1348     my $name;
1349
1350     my $i = 0;
1351
1352     $i++ if ref $tree->[$i] eq 'HASH';
1353
1354     while (defined $tree->[$i])
1355     {
1356         if ($tree->[$i] eq 'Name')
1357         {
1358             $i++;
1359             if (ref( $tree->[$i][0] ) eq 'HASH' and $tree->[$i][1] eq '0')
1360             {
1361                 $name = $tree->[$i][2];
1362                 last;
1363             }
1364             else
1365             {
1366                 warn "wrong Name\n";
1367             }
1368             $i++;
1369         }
1370         else
1371         {
1372             $i++;
1373             $i++;
1374         }
1375     }
1376
1377     unless (defined $name)
1378     {
1379         warn "Menu has no name element\n";
1380     }
1381
1382     return $name;
1383 }
1384
1385 sub append_menu
1386 {
1387     my ($target, $source) = @_;
1388
1389     my $i = 0;
1390     $i++ if ref $source->[$i] eq 'HASH';
1391
1392     while (defined $source->[$i])
1393     {
1394         if ($source->[$i] ne 'Name')
1395         {
1396             push @$target, $source->[$i];
1397             push @$target, $source->[ $i + 1 ];
1398         }
1399         $i++;
1400         $i++;
1401     }
1402 }
1403
1404 sub merge_menus
1405 {
1406     my ($tree) = @_;
1407
1408     my %used;    #menu name already used
1409
1410     my $i = 0;
1411     $i++ if ref $tree->[$i] eq 'HASH';
1412
1413     while (defined $tree->[$i])
1414     {
1415         if ($tree->[$i] eq 'Menu')
1416         {
1417             my $name = get_menu_name($tree->[ $i + 1 ]);
1418             if (defined $used{$name})
1419             {
1420                 my $target = $used{$name};
1421                 append_menu($tree->[$target], $tree->[ $i + 1 ]);
1422
1423                 splice @$tree, $i, 2;
1424             }
1425             else
1426             {                           # first appearance
1427                 $used{$name} = $i + 1;
1428                 $i++;
1429                 $i++;
1430             }
1431         }
1432         else
1433         {
1434             $i++;
1435             $i++;
1436         }
1437     }
1438
1439     $i = 0;
1440     $i++ if ref $tree->[$i] eq 'HASH';
1441
1442     while (defined $tree->[$i])
1443     {
1444         if ($tree->[$i] eq 'Menu')
1445         {
1446             merge_menus($tree->[ $i + 1 ]);
1447         }
1448         $i++;
1449         $i++;
1450     }
1451 }
1452
1453 sub read_Move
1454 {
1455     my ( $tree, $hash ) = @_;
1456     my $i = 0;
1457     my $old = '';
1458     $i++ if ref $tree->[$i] eq 'HASH';
1459
1460     while (defined $tree->[$i])
1461     {
1462         if ($tree->[$i] eq 'Old')
1463         {
1464             $i++;
1465             if (ref( $tree->[$i][0] ) eq 'HASH' and $tree->[$i][1] eq '0')
1466             {
1467                 $old = $tree->[$i][2];
1468             }
1469             else
1470             {
1471                 warn "wrong Old\n";
1472                 exit 1 if $die_on_error;
1473             }
1474             $i++;
1475         }
1476         if ($tree->[$i] eq 'New')
1477         {
1478             $i++;
1479             if (ref( $tree->[$i][0] ) eq 'HASH' and $tree->[$i][1] eq '0')
1480             {
1481                 $hash->{$old} = $tree->[$i][2];
1482             }
1483             else
1484             {
1485                 warn "wrong New\n";
1486                 exit 1 if $die_on_error;
1487             }
1488             $i++;
1489         }
1490         else
1491         {
1492             $i++;
1493             $i++;
1494         }
1495     }
1496 }
1497
1498 sub find_menu_in_tree
1499 {
1500     my ( $path, $tree ) = @_;
1501
1502     my $root = $path;
1503     $root =~ s/\/.*$//;
1504
1505     my $subpath = $path;
1506     $subpath =~ s/^[^\/]*\/*//;
1507
1508     my $i = 0;
1509     $i++ if ref $tree->[$i]  eq 'HASH';
1510
1511     while (defined $tree->[$i])
1512     {
1513         if ($tree->[$i] eq 'Menu')
1514         {
1515             if ($root eq get_menu_name( $tree->[ $i + 1 ]))
1516             {
1517                 if ($subpath eq '')
1518                 {
1519                     return {
1520                         'parent' => $tree,
1521                         'index'  => $i,
1522                         'menu'   => $tree->[ $i + 1 ]
1523                     };
1524                 }
1525                 return find_menu_in_tree( $subpath, $tree->[ $i + 1 ] );
1526             }
1527         }
1528         $i++;
1529         $i++;
1530     }
1531
1532     #FIXME - TA:  Don't return undef here, it's bad.
1533     return undef;
1534 }
1535
1536 sub copy_menu
1537 {
1538     my ($path, $tree) = @_;
1539     my $tail;
1540     my $child;
1541
1542     foreach my $elem (reverse split( /\//, $path))
1543     {
1544         next if $elem eq '';
1545         my $menu = [ {}, 'Name', [ {}, 0, $elem ] ];
1546         push @$menu, ( 'Menu', $child ) if defined $child;
1547         $tail = $menu unless defined $tail;
1548         $child = $menu;
1549     }
1550     append_menu( $tail, $tree );
1551     return $child;
1552 }
1553
1554 sub move_menus
1555 {
1556     my ($tree) = @_;
1557     my %move;
1558     my $i = 0;
1559     $i++ if ref $tree->[$i] eq 'HASH';
1560
1561     while (defined $tree->[$i])
1562     {
1563         if ($tree->[$i] eq 'Move')
1564         {
1565             read_Move($tree->[ $i + 1 ], \%move);
1566             splice @$tree, $i, 2;
1567         }
1568         else
1569         {
1570             $i++;
1571             $i++;
1572         }
1573     }
1574
1575     foreach my $source (keys %move)
1576     {
1577         my $sourceinfo = find_menu_in_tree($source, $tree);
1578
1579         if (defined $sourceinfo)
1580         {
1581             my $target = copy_menu($move{$source}, $sourceinfo->{'menu'});
1582             splice @{ $sourceinfo->{'parent'} }, $sourceinfo->{'index'}, 2;
1583             push @$tree, ('Menu', $target);
1584             merge_menus($tree);
1585         }
1586     }
1587     $i = 0;
1588     $i++ if ref $tree->[$i] eq 'HASH';
1589
1590     while (defined $tree->[$i])
1591     {
1592         if ($tree->[$i] eq 'Menu')
1593         {
1594             move_menus($tree->[ $i + 1 ]);
1595         }
1596         $i++;
1597         $i++;
1598     }
1599 }
1600
1601 sub remove_allocated
1602 {
1603     my ($menu) = @_;
1604
1605     my $i = 0;
1606     while ($i < @{ $menu->{'entries'} })
1607     {
1608         my $entry = $menu->{'entries'}[$i];
1609
1610         if ($entry->{type} eq 'menu')
1611         {
1612             remove_allocated( $entry->{menu} );
1613             $i++;
1614         }
1615         elsif ($entry->{type} eq 'desktop'
1616                 and  $menu->{'OnlyUnallocated'}
1617                 and $entry->{desktop}{'refcount'} > 1)
1618         {
1619             $entry->{desktop}{'refcount'}--;
1620             splice @{ $menu->{'entries'} }, $i, 1;
1621         }
1622         else
1623         {
1624             $i++;
1625         }
1626     }
1627     return 0;
1628 }
1629
1630 sub remove_empty_menus
1631 {
1632     my ($menu) = @_;
1633
1634     my $i = 0;
1635     while ($i < @{ $menu->{'entries'} })
1636     {
1637         my $entry = $menu->{'entries'}[$i];
1638
1639         if ($entry->{type} eq 'menu' and remove_empty_menus($entry->{menu}))
1640         {
1641             splice @{ $menu->{'entries'} }, $i, 1;
1642         }
1643         else
1644         {
1645             $i++;
1646         }
1647     }
1648
1649     @{ $menu->{'entries'} } == 0 ? return 1 : return 0;
1650 }
1651
1652 sub prepare_exec
1653 {
1654     my ( $exec, $desktop ) = @_;
1655
1656     # Take out filename flags, etc.
1657     $exec =~ s/%f//g;
1658     $exec =~ s/%F//g;
1659     $exec =~ s/%u//g;
1660     $exec =~ s/%U//g;
1661     $exec =~ s/%d//g;
1662     $exec =~ s/%D//g;
1663     $exec =~ s/%n//g;
1664     $exec =~ s/%N//g;
1665     $exec =~ s/%i//g;
1666     $exec =~ s/%k//g;
1667     $exec =~ s/%v//g;
1668     $exec =~ s/%m//g;
1669
1670     my $caption = $desktop->{Name};
1671     $exec =~ s/%c/$caption/g;
1672     $exec =~ s/%%/%/g;
1673
1674     if (defined $desktop->{Terminal})
1675     {
1676             if ($desktop->{Terminal} eq '1' or $desktop->{Terminal} eq 'true')
1677         {
1678                 $exec = "$TERM_CMD $exec";
1679             }
1680     }
1681
1682     if (defined $desktop->{'X-KDE-SubstituteUID'})
1683     {
1684             if ($desktop->{'X-KDE-SubstituteUID'} eq '1'
1685                 or $desktop->{'X-KDE-SubstituteUID'} eq 'true')
1686         {
1687                 $exec = "$root_cmd $exec"
1688             }
1689     }
1690     return $exec;
1691 }
1692
1693 sub get_loc_entry
1694 {
1695     my ( $desktop, $entry ) = @_;
1696
1697     foreach my $key (@language_keys)
1698     {
1699         my $loc_entry = $entry . "[$key]";
1700
1701         if (defined $desktop->{$loc_entry} and
1702             $desktop->{$loc_entry} !~ /^\s*$/)
1703         {
1704             return $desktop->{$loc_entry};
1705         }
1706     }
1707
1708     return $desktop->{$entry};
1709 }
1710
1711 sub preprocess_menu
1712 {
1713     # localize, sort, prepare_exec
1714     my ($menu) = @_;
1715
1716     return 0 if $menu->{'Deleted'};
1717     return 0 unless check_show_in( $menu->{'Directory'} );
1718
1719         if( defined $menu->{'Directory'} and
1720         defined $menu->{'Directory'}->{'NoDisplay'} and
1721         $menu->{'Directory'}->{'NoDisplay'} eq 'true')
1722     {
1723         return 0;
1724     }
1725
1726     my $menu_name = $menu->{'Name'};
1727     if (defined $menu->{'Directory'})
1728     {
1729         my $directory = $menu->{'Directory'};
1730         my $directory_name = get_loc_entry( $directory, 'Name' );
1731
1732         if (defined $directory_name)
1733         {
1734               if( !defined $directory->{"Encoding"} or
1735                   $directory->{"Encoding"} eq 'UTF-8')
1736               {
1737                   Encode::from_to($directory_name, "utf8", $charset);
1738               }
1739
1740               $menu_name = $directory_name;
1741         }
1742     }
1743
1744     $menu->{'PrepName'} = $menu_name;
1745
1746     my $i = 0;
1747     while ( defined $menu->{'entries'}[$i] )
1748     {
1749         my $entry = $menu->{'entries'}[$i];
1750         if ( $entry->{'type'} eq 'desktop' )
1751         {
1752             my $desktop = $entry->{desktop};
1753             my $name = $desktop->{'id'};
1754             my $desktop_name = get_loc_entry( $desktop, 'Name' );
1755             if ( defined $desktop_name )
1756             {
1757                 Encode::from_to( $desktop_name, "utf8", $charset )
1758                   if !defined $desktop->{"Encoding"}
1759                       || $desktop->{"Encoding"} eq 'UTF-8';
1760                 $name = $desktop_name;
1761             }
1762             $desktop->{'PrepName'} = $name;
1763             $entry->{'Name'}       = $name;
1764             $entry->{'PrepName'}   = $name;
1765             $desktop->{'PrepExec'} = prepare_exec( $desktop->{Exec}, $desktop );
1766             $i++;
1767         }
1768         elsif ( $entry->{type} eq 'menu' )
1769         {
1770             if ( preprocess_menu( $entry->{'menu'} ) )
1771             {
1772                 $entry->{'Name'}     = $entry->{'menu'}{'Name'};
1773                 $entry->{'PrepName'} = $entry->{'menu'}{'PrepName'};
1774                 $i++;
1775             }
1776             else
1777             {
1778                 splice @{ $menu->{'entries'} }, $i, 1;
1779             }
1780         }
1781         else
1782         {
1783             warn "wrong menu entry type: $entry->{type}";
1784             exit 1 if $die_on_error;
1785             splice @{ $menu->{'entries'} }, $i, 1;
1786         }
1787     }
1788
1789     $menu->{'entries'} = [
1790         sort {
1791             $b->{'type'} cmp $a->{'type'}
1792               || $a->{'PrepName'} cmp $b->{'PrepName'}
1793           } @{ $menu->{'entries'} }
1794     ];
1795
1796     $i = 0;
1797     my $prev_entry;
1798     while ( defined $menu->{'entries'}[$i] )
1799     {
1800         my $entry = $menu->{'entries'}[$i];
1801         if (defined $prev_entry
1802             and $entry->{'type'}                       eq 'desktop'
1803             and $prev_entry->{'type'}                  eq 'desktop'
1804             and $prev_entry->{'PrepName'}              eq $entry->{'PrepName'}
1805             and $prev_entry->{'desktop'}->{'PrepExec'} eq
1806             $entry->{'desktop'}->{'PrepExec'} )
1807         {
1808             splice @{ $menu->{'entries'} }, $i, 1;
1809         }
1810         else
1811         {
1812             $prev_entry = $entry;
1813             $i++;
1814         }
1815     }
1816     return 1;
1817 }
1818
1819 sub output_fvwm2_menu
1820 {
1821     my ($menu, $toplevel, $path) = @_;
1822
1823     $path = '' unless defined $path;
1824     $toplevel = 1 unless defined $toplevel;
1825
1826     my $output = '';
1827     my $label = '';
1828     my $menu_name = $menu->{'PrepName'};
1829     my $menu_id = "$path-" . $menu->{'Name'};
1830     $menu_id =~ s/\s/_/g;
1831     $menu_id = $menu_prefix if $toplevel;
1832     foreach my $entry ( @{ $menu->{'entries'} } )
1833     {
1834         if ( $entry->{type} eq 'menu' ) {
1835             $output .= output_fvwm2_menu( $entry->{'menu'}, 0, $menu_id );
1836         }
1837     }
1838     $output .= "DestroyMenu \"$menu_id\"\n";
1839     $output .= "AddToMenu \"$menu_id\" \"$dmicon{'fvwm_title'}$label$menu_name\" Title\n";
1840
1841     if ($MENU_STYLE ne '')
1842     {
1843             push @menus_for_style, $menu_id;
1844     }
1845
1846     foreach my $entry ( @{ $menu->{'entries'} } )
1847     {
1848         if ( $entry->{type} eq 'desktop' )
1849         {
1850             my $desktop = $entry->{desktop};
1851             my $name = $desktop->{'PrepName'};
1852             my $exec = $desktop->{'PrepExec'};
1853             $output .= "+                \"$dmicon{'fvwm_app'}$name\" Exec $exec\n";
1854         }
1855         elsif ( $entry->{type} eq 'menu')
1856         {
1857             my $name = $entry->{'menu'}{'PrepName'};
1858             my $id   = "$menu_id-" . $entry->{'menu'}{'Name'};
1859             $id =~ s/\s/_/g;
1860             $output .= "+                \"$dmicon{'fvwm_folder'}$name\" Popup \"$id\"\n";
1861         }
1862         else
1863         {
1864             warn "wrong menu entry type: $entry->{type}";
1865         }
1866     }
1867
1868     $output .= "\n";
1869     if ("$menu_id" eq "$menu_prefix-System_Tools")
1870     {
1871             $output .= "AddToMenu \"$menu_prefix-System_Tools\" " .
1872                 "\"$dmicon{'fvwm_app'}Regenerate Applications Menu\" " .
1873                 "FvwmForm FvwmForm-Desktop\n";
1874     }
1875     return $output;
1876 }
1877
1878 sub get_root_menu
1879 {
1880     my @menu_bases = (qw(
1881         applications
1882         debian-menu
1883         )
1884     );
1885
1886     # XXX - TA:  2011-04-10:  Is it enough to assume only one match here is
1887     #            sufficient?
1888     foreach my $dir ( split( /:/, $xdg_config_dirs ), "/etc/xdg" )
1889     {
1890         foreach my $menu_name (@menu_bases)
1891         {
1892             check_file("$dir/menus/$menu_name.menu");
1893             if ( -f "$dir/menus/$menu_name.menu" ) {
1894                 return "$dir/menus/$menu_name.menu";
1895             }
1896         }
1897     }
1898     return "";
1899 }
1900
1901 sub get_app_dirs
1902 {
1903     my %used;
1904     my $ret = '';
1905
1906     return $ret unless check_app("kde-config");
1907
1908     my @kde_xdgdata = split( /:/, `kde-config --path xdgdata-apps` );
1909
1910     foreach (@kde_xdgdata)
1911     {
1912         s/\/applications\/*\s*$//;
1913     }
1914
1915     foreach my $d (split( /:/, $xdg_data_dirs ),
1916         @kde_xdgdata, "/usr/share", "/opt/gnome/share")
1917     {
1918         my $dir = $d;
1919         $dir =~ s/\/*$//;
1920         next if defined $used{$dir};
1921         next if check_file("$dir/applications") ne 'D';
1922         $ret .= ':' if $ret ne '';
1923         $ret .= "$dir/applications";
1924         $used{$dir} = 1;
1925     }
1926     if ($verbose)
1927     {
1928         foreach ( split( ':', $ret ) )
1929         {
1930             warn "app dirs $_\n";
1931         }
1932     }
1933     return $ret;
1934 }
1935
1936 sub get_desktop_dirs
1937 {
1938     my %used;
1939     my $ret = '';
1940     foreach my $dir ( split( /:/, $xdg_data_dirs ),
1941         qw(/usr/share /opt/kde3/share /opt/gnome/share) )
1942     {
1943         next if defined $used{$dir};
1944         next if check_file("$dir/desktop-directories") ne 'D';
1945         $ret .= ':' if $ret ne '';
1946         $ret .= "$dir/desktop-directories";
1947         $used{$dir} = 1;
1948     }
1949     warn "desktop dirs $ret\n" if $verbose;
1950     return $ret;
1951 }
1952
1953 sub get_KDE_legacy_dirs
1954 {
1955     my %used;
1956     my @ret = ();
1957     my @legacy_dirs = (qw(
1958         /etc/opt/kde3/share/applnk
1959         /opt/kde3/share/applnk
1960         )
1961     );
1962
1963     if (check_app("kde-config"))
1964     {
1965         push @legacy_dirs, reverse(split(/:/,`kde-config --path apps` ));
1966     }
1967
1968     foreach my $d ( @legacy_dirs )
1969     {
1970         my $dir = $d;
1971         chomp $dir;
1972         $dir =~ s/\/*$//;
1973         next if defined $used{$dir};
1974         next if check_file("$dir") ne 'D';
1975         $used{$dir} = 1;
1976         push @ret, $dir;
1977     }
1978     warn "KDE legacy dirs @ret\n" if $verbose;
1979     return @ret;
1980 }
1981
1982 sub prepare_language_keys
1983 {
1984     my ($language) = @_;
1985
1986     my @keys;
1987     $language =~ s/\.[^@]*//;    # remove .ENCODING
1988
1989     if ( $language =~ /^([^_]*)_([^@]*)@(.*)$/)
1990     {
1991         # LANG_COUNTRY@MODIFIER
1992         push @keys, $1 . '_' . $2 . '@' . $3;
1993         push @keys, $1 . '_' . $2;
1994         push @keys, $1 . '@' . $3;
1995         push @keys, $1;
1996     }
1997     elsif ($language =~ /^([^_]*)_([^@]*)$/)
1998     {
1999         # LANG_COUNTRY
2000         push @keys, $1 . '_' . $2;
2001         push @keys, $1;
2002     }
2003     elsif ($language =~ /^([^_]*)@(.*)$/)
2004     {
2005         # LANG@MODIFIER
2006         push @keys, $1 . '@' . $2;
2007         push @keys, $1;
2008     }
2009     elsif ($language =~ /^([^_@]*)$/)
2010     {
2011         # LANG
2012         push @keys, $1;
2013     }
2014
2015     return @keys;
2016 }
2017
2018 # Fixme, remove unsupported options.
2019 sub show_help
2020 {
2021         print <<END_HELP;
2022 A perl script which parses xdg menu definitions to build
2023 the corresponding fvwm menus.  The script can also build
2024 Icon and MiniIcon styles for the desktop applications.
2025
2026 Usage: $0 [OPTIONS]
2027 Options:
2028         --help                    show this help and exit
2029         --version                 show version and exit
2030         --install-prefix DIR      install prefix of the desktop
2031         --desktop NAME            desktop to build the menu for it:
2032                 gnome-sys (default), gnome-user, gnome-redhat, gnome-madriva,
2033                 kde-sys, kde-user
2034         --type NAME               fvwm (default) or gtk for a FvwmGtk menu
2035         --fvwmgtk-alias NAME      FvwmGtk module name, default is FvwmGtk
2036         --title NAME              menu title, default depends on --desktop
2037         --name NAME               menu name, default depends on --desktop
2038         --merge-user-menu         merge the system menu with the user menu
2039         --enable-mini-icons       enable mini-icons in menu
2040         --enable-tran-mini-icons  enable mini-icons in menu and
2041                 translation of foo.png icon names to foo.xpm
2042         --mini-icons-path DIR     path of menus icons (relative to your
2043                 ImagePath), default is 'mini/'
2044         --png-icons-path DIR      path of .png icons, default is your ImagePath
2045         --tran-mini-icons-path DIR      path of menus icons for translation
2046         --check-mini-icons PATH   check if the mini icons are in PATH
2047         --icon-toptitle micon:law:place:sidepic:color  mini-icon for the top
2048                  title and sidepic for the top menu
2049         --icon-title micon:law:place:sidepic:color     as above for sub menus
2050         --icon-folder micon:law:place   mini-icons for folder item
2051         --icon-app micon:law:place      mini-icon for applications item
2052         --wm-icons                define menu icon names to use with wm-icons
2053         --enable-style            build icons and mini-icons style
2054         --enable-tran-style       as above with translation (for FvwmGtk menus)
2055         --icon-style micon:icon:law     icons for style
2056         --icons-path DIR          define the directory of the icons,
2057                 the default is very good
2058         --tran-icons-path DIR     similar to the above option.
2059         --check-icons PATH        check if the icons are in the PATH
2060         --submenu-name-prefix NAME      in general not useful
2061         --dir DIR                 use path as desktop menu description
2062         --destroy-type FLAG       how to destroy menu, valid values:
2063                 'yes', 'no', 'dynamic', the default depends on --type
2064         --xterm CMD               complete terminal command to run applications
2065                 in it, default is 'xterm -e'
2066         --lang NAME               language, default is \$LANG
2067         --utf8                    For desktop entries coded in UTF-8 (KDE2)
2068         --uniconv                 Use (un)iconv for UTF-8 translation
2069         --uniconv-exec            uniconv or iconv (default)
2070         --menu-style name         assign specified MenuStyle name to menus
2071         --[no]check-app           [do not] check that apps are in your path
2072         --time-limit NUM          limit script running time to NUM seconds
2073         --verbose                 display debug type info oni STDERR
2074 Short options are ok if not ambiguous: -h, -x, -icon-a.
2075 END_HELP
2076         exit 0;
2077 }
2078
2079 # Check if application binary is executable and reachable
2080 sub check_app
2081 {
2082         my($app) = @_;
2083         # If full path, dont use path, just check path
2084         if ( substr($app,0,1) eq '/' and -x $app )
2085     {
2086         return 1;
2087     }
2088
2089         # Check if an application is in the path
2090         foreach (@PATH_DIRS)
2091     {
2092                 return 1 if -x "$_/$app";
2093         }
2094
2095         return 0;
2096 }
2097
2098 sub show_version
2099 {
2100         print "$version\n";
2101         exit 0;
2102 }
2103
2104 sub obsolete
2105 {
2106     my ($arg) = @_;
2107     print "WARNING: Argument \"$arg\" obsolete.  Ignored.\n";
2108 }
2109 # Local Variables:
2110 # compile-command: "perl fvwm-menu-desktop.in --enable-mini-icons --fvwm-icons"
2111 # End: