#!@PERL@ # # --------------------------------------------------------------------------- # fvwm-menu-desktop # See the man page fvwm-menu-desktop.1 for instructions. # # Created on 22/07/1999 by Olivier Chapuis # # Updated on 15/08/1999 by Mikhael Goikhman # # --------------------------------------------------------------------------- # COPYING # # The script is distributed by the same terms as fvwm itself. # See GNU General Public License for details. # #---------------------------------------------------------------------------- # The script: Main #-------- # Modules use strict; # For command line options use Getopt::Long; my $version = "@VERSION@"; #-------- # Defaults (most of them can be modified with the options) # paths my $GNOME_PREFIX = '/usr'; # gnome install-dir # Default is "gnome" since fvwm is gnome compliant and not kde compliant. my $APPS_DIR = "$GNOME_PREFIX/share/gnome/apps"; my $GNOME_APPS = $APPS_DIR; my $KDE_PREFIX = $ENV{KDEDIR} || '/usr'; my $KDE_APPS = "$KDE_PREFIX/share/applnk"; my $KDE_MINI_ICONS = "$KDE_PREFIX/share/icons/mini/"; my $KDE3_MINI_ICONS = "$KDE_PREFIX/share/icons/hicolor/16x16/apps/"; my $KDE_ICONS = "$KDE_PREFIX/share/icons/"; my $KDE3_ICONS = "$KDE_PREFIX/share/icons/hicolor/48x48/apps/"; my $OPT_INSTALL_PREFIX = ''; # Default for the mini-icons is mini/ (relatively to the ImagePath) my $MINI_ICONS_DIR = 'mini/'; # Then the default for icon is ImagePath (consistent with kde, fvwm2gnome # and almost consistent with wm-icons) my $ICONS_DIR = ''; # For png icons my $PNG_ICONS = ''; # Default for mini-icons and icons translation my $TRAN_MINI_ICONS = 'mini/'; my $TRAN_ICONS = ''; #Unused path at the present time #$GNOME_ICONS = "$GNOME_PREFIX/share/pixmaps/"; # Name my $MENU_TITLE = 'Gnome System Menu'; # default top title my $MENU_NAME = 'gnome-sys'; # default top menu name my $MENU_TYPE = 'fvwm'; # default menu type my $DESKTOP = ''; # will contain Kde or Gnome if possible my $OPT_MENU_TITLE = ''; my $OPT_MENU_NAME = ''; my $fvwmGtkName = "FvwmGtk"; # FvwmGtk module name # Default "icon" # mini-icons default (app for application, folder for folder, title for # submenu title, toptitle for the top title, fvwm_ for fvwm menu, gtk_ for # FvwmGtk menu) the variable $flag will be fvwm_ or gtk_. Use kde # default icons for fvwm menus and gnome icons for gtk menus my %DI; $DI{fvwm_app} = 'mini-x.xpm:dh:%::'; # micon:law:placement:unused $DI{fvwm_folder} = 'folder.xpm:dh:%::'; # idem $DI{fvwm_title} = 'folder.xpm:dh:%::'; # micon:law:place:spic:color $DI{fvwm_toptitle} = 'mini-k.xpm:no:%::'; # idem $DI{gtk_app} = 'gnome-default.png:dh:::'; # idem $DI{gtk_folder} = 'gnome-folder.png:dh:::'; # micon:law:unused $DI{gtk_title} = 'gnome-folder.png:dh:::'; # idem $DI{gtk_toptitle} = 'gnome-logo-icon-transparent.png:no:::'; # idem my @list=(); my $i=''; my %dmicon; my %law; my %place; my %spic; my %scolor; foreach $i (keys(%DI)) { @list = split(':',$DI{$i}); $dmicon{$i} = $list[0]; # "default" mini-icon $law{$i} = $list[1]; # default law $place{$i} = $list[2]; # default position $spic{$i} = $list[3]; # sidepic icon $scolor{$i} = $list[4]; # color for sidepic $DI{$i} = ''; } my $MINI_ICONS = 0; # mini-icon disabled (enable =1) my $TRAN = 0; # mini-icon translation disabled (enable =1) my $wmIcons = 0; # use wm-icons compatible menu icon names # default for style my %dstyle; $dstyle{mini_icon} = 'mini-x.xpm'; # default MiniIcons Style $dstyle{gnome_mini_icon} = 'gnome-default.xpm'; $dstyle{icon} = 'x.xpm'; # default Icons Style $dstyle{gnome_icon} = 'gnome-default.xpm'; my $style_law = 'dh'; # default law my $addstyle = ''; # a style to add every where my $STYLE = 0; # style is disable (enable =1) my $TRAN_STYLE = 0; # translation for style is disabled (enable =1) my $STYLEOUTPUT = ''; # The styles are in this variable my $ICON_STYLE = ''; # default term for runnig applications in a terminal my $TERM_CMD = "xterm -e"; # Other stuff my $timelimit = 15; # limit runing time for the script my $LANG = $ENV{LANG} || ""; # Internationalization support :o) my $UTF8 = 0; # KDE2 use UTF-8 my $UTF8_TR = ""; # charset type for UTF-8 translation my $UNICONV = ""; # use a convert tool for UTF8 tr my $UNICONV_EXEC = ""; # iconv, uniconv or internal my @PATH_DIRS = split(':',$ENV{PATH}); # for checking if applications exist my $CHECK = 1; # we check by default my $MENU_DESTROY = ''; my $DESC_DIR = ''; my $SUBMENUS_PREFIX = ''; # Menu Style option my $MENU_STYLE = ""; my @menusForStyle = (); my $name = ""; my $l = ""; my $j = ""; my $tmp_icon =""; my $level = 0; my $nlevel = 0; my $top_level = 0; my $cdir = ""; my $dir = ""; my @Rec_Dir_List = (); my @Main_List = (); my $flag = ""; my $order =""; my $add = 1; # merge usr menu my $mergeUserMenu = 0; my $mergeDir = ""; my $mergeUserDir = ""; my $sysDir = ""; my $mergeDirType = ""; my $userMenuDone = 0; # check icons my $checkIcons = ""; my $checkMiniIcons = ""; my @checkIconsPath = (); my @checkMiniIconsPath = (); #-------- # Read the options GetOptions( "help|h|?" => \&showHelp, "version|v|V" => \&showVersion, "install-prefix:s" => $OPT_INSTALL_PREFIX, "desktop:s" => \$MENU_NAME, "type:s" => \$MENU_TYPE, "fvwmgtk-alias=s" => \$fvwmGtkName, "title:s" => \$OPT_MENU_TITLE, "name:s" => \$OPT_MENU_NAME, "enable-mini-icons" => \$MINI_ICONS, "enable-tran-mini-icons" => \$TRAN, "mini-icons-path:s" => \$MINI_ICONS_DIR, "png-icons-path:s" => \$PNG_ICONS, "tran-mini-icons-path:s" => \$TRAN_MINI_ICONS, "icon-toptitle:s" => \$DI{"fvwm_toptitle"}, "icon-title:s" => \$DI{"fvwm_title"}, "icon-folder:s" => \$DI{"fvwm_folder"}, "icon-app:s" => \$DI{"fvwm_app"}, "enable-style" => \$STYLE, "enable-tran-style" => \$TRAN_STYLE, "icon-style:s" => \$ICON_STYLE, "icons-path:s" => \$ICONS_DIR, "tran-icons-path:s" => \$TRAN_ICONS, "submenu-name-prefix:s" => \$SUBMENUS_PREFIX, "dir:s" => \$DESC_DIR, "destroy-type:s" => \$MENU_DESTROY, "xterm:s" => \$TERM_CMD, "lang:s" => \$LANG, "utf8" => \$UTF8, "uniconv=s" => \$UNICONV, "uniconv-exec=s" => \$UNICONV_EXEC, "menu-style=s" => \$MENU_STYLE, "check-app!" => \$CHECK, "wm-icons" => \$wmIcons, "time-limit=s" => \$timelimit, "merge-user-menu" => \$mergeUserMenu, "check-mini-icon=s" => \$checkMiniIcons, "check-icons=s" => \$checkIcons, ) || wrongUsage(); wrongUsage() if @ARGV; die "fvwm-menu-desktop: Incorrect alias ($fvwmGtkName) is given\n" if $fvwmGtkName !~ /^\w[\w\d\.-]*$/; sub printModuleConfig (@) { foreach (@_) { print "*${fvwmGtkName}: $_\n"; } } #-------------------------------- # INITIALISATION of the variables # for limiting running time to $timelimit my $startime = time; $timelimit = 300 if $timelimit <= 0 || $timelimit > 300; # see if we build a gnome or a kde menu. $DESKTOP = 'Kde' if ( $MENU_NAME =~ /kde/ ); $DESKTOP = 'Gnome' if ( $MENU_NAME =~ /gnome/ ); if ( $OPT_INSTALL_PREFIX ne '' ) { $APPS_DIR = $GNOME_APPS = "$OPT_INSTALL_PREFIX/share/gnome/apps"; $KDE_APPS = "$OPT_INSTALL_PREFIX/share/applnk"; $KDE_MINI_ICONS = "$OPT_INSTALL_PREFIX/share/icons/mini"; $KDE3_MINI_ICONS = "$OPT_INSTALL_PREFIX/share/icons/hicolor/16x16/apps/"; $KDE_ICONS = "$OPT_INSTALL_PREFIX/share/icons"; $KDE3_ICONS = "$OPT_INSTALL_PREFIX/share/icons/hicolor/48x48/apps/"; #$GNOME_ICONS = "$OPT_INSTALL_PREFIX/share/pixmaps"; } if ( $MENU_TYPE eq 'gtk' ) { $flag ='gtk_'; $MENU_DESTROY = 'no' if ( ! $MENU_DESTROY =~ /^y/ ); } else { $flag ='fvwm_'; $MENU_DESTROY = 'yes' if ( !($MENU_DESTROY =~ /^n/ || $MENU_DESTROY =~ /^d/) ); } if ( $MENU_NAME eq 'gnome-sys' && $mergeUserMenu) { $mergeUserDir = "$ENV{HOME}/.gnome/apps"; } if ( $MENU_NAME eq 'gnome-user' ) { $APPS_DIR = "$ENV{HOME}/.gnome/apps"; $MENU_TITLE = 'Gnome User Menu'; } if ( $MENU_NAME eq 'gnome-redhat' ) { $APPS_DIR = "$ENV{HOME}/.gnome/apps-redhat"; $MENU_TITLE = 'Gnome RedHat Menu'; } if ( $MENU_NAME eq 'gnome-mandriva' ) { $APPS_DIR = "$ENV{HOME}/.gnome/apps-mdk"; $MENU_TITLE = 'Gnome Mandriva Menu'; } if (! -d $KDE_APPS) { $KDE_PREFIX = ''; } if ( $DESKTOP eq 'Kde' && $KDE_PREFIX eq '' && $DESC_DIR eq '') { die "fvwm-menu-desktop: It seems that kde is _not_ installed on your\n" . "machine! If it is, please use the --install-prefix or the\n" . "--dir option (see the man page).\n"; } if ( $MENU_NAME eq 'kde-sys' ) { $APPS_DIR = $KDE_APPS; $MENU_TITLE = 'Kde System Menu'; if ($mergeUserMenu) { $mergeUserDir = "$ENV{HOME}/.kde/share/applnk"; } } if ( $MENU_NAME eq 'kde-user' ) { $APPS_DIR = "$ENV{HOME}/.kde/share/applnk"; $MENU_TITLE = 'Kde User Menu'; } if ( $DESC_DIR ne '') { $APPS_DIR = $DESC_DIR; $DESC_DIR =~ s/\/*$//; $name = substr($DESC_DIR,rindex($DESC_DIR,'/')+1); $DESKTOP = 'Kde' if ( $DESC_DIR =~ /kde/ && $DESKTOP eq ''); $DESKTOP = 'Gnome' if ( $DESC_DIR =~ /gnome/ && $DESKTOP eq ''); $MENU_NAME = $MENU_TITLE = "$name"; if ( $DESKTOP ne '' ) { $MENU_NAME = "$DESKTOP-$MENU_NAME"; $MENU_TITLE = "$DESKTOP $name"; } } # Menu Title is recomputed later if $opt_menu_name is undefined # (try to use Desktop hints). $MENU_NAME = $OPT_MENU_NAME if ( $OPT_MENU_NAME ne '' ); $MENU_TITLE = $OPT_MENU_TITLE if ( $OPT_MENU_TITLE ne '' ); # Prefix for submenu: if ($SUBMENUS_PREFIX ne '') { $SUBMENUS_PREFIX = "$SUBMENUS_PREFIX-" } else { $SUBMENUS_PREFIX = "$MENU_NAME-" } # --------- # Icon init if ($wmIcons) { $MINI_ICONS = 1; $MINI_ICONS_DIR = ""; $DI{"fvwm_toptitle"} = "menu/folder-open.xpm:ow"; $DI{"fvwm_title"} = "menu/folder-open.xpm:ow"; $DI{"fvwm_folder"} = "menu/folder.xpm:ow"; $DI{"fvwm_app"} = "menu/utility.xpm:ow"; } if ( $TRAN ) { $MINI_ICONS = 1 } if ( $MINI_ICONS_DIR ne 'mini/' || $ICONS_DIR ne '') { if ($MINI_ICONS_DIR ne '' ) { $MINI_ICONS_DIR =~ s/\/*$/\// }; if ( $ICONS_DIR eq '' ) { $ICONS_DIR = up_directory($MINI_ICONS_DIR) } else { if ( $ICONS_DIR eq 'inpath' ) { $ICONS_DIR = '' } else { $ICONS_DIR =~ s/\/*$/\// if ($MINI_ICONS_DIR ne '' ) } } } if ( $TRAN_MINI_ICONS ne 'mini/' || $TRAN_ICONS ne '' ) { if ($TRAN_MINI_ICONS ne '' ) { $TRAN_MINI_ICONS =~ s/\/*$/\// }; if ( $TRAN_ICONS eq '' ) { $TRAN_ICONS = up_directory($TRAN_MINI_ICONS) } else { if ( $TRAN_ICONS eq 'inpath' ) { $TRAN_ICONS = '' } else { $TRAN_ICONS =~ s/\/*$/\// if ($TRAN_ICONS ne '' ) } } } $PNG_ICONS =~ s/\/*$/\// if ($PNG_ICONS ne ''); # init default mini-icons, law, place, sidepic, color foreach $i (qw(folder title toptitle app)) { $DI{"gtk_$i"} = $DI{"fvwm_$i"}; } if ( $flag eq 'gtk_') { foreach $i (qw(gtk_app gtk_folder gtk_title gtk_toptitle)) { $dmicon{$i} = "$PNG_ICONS$dmicon{$i}"; @list = split(':',$DI{$i}); $l = @list; while ( $l <= 2 ) { push(@list,''); ++$l } $law{$i} = $list[1] if ($list[1] eq 'no' || $list[1] eq 'ow' || $list[1] eq 're' || $list[1] eq 'dh' ); $dmicon{$i} = "$PNG_ICONS$list[0]" if ( $list[0] ne '' ); $dmicon{$i} = '' if ( $law{$i} eq 'no' || !$MINI_ICONS ); } } else { foreach $i (qw(fvwm_app fvwm_folder fvwm_title fvwm_toptitle)) { # With the mini-icons-tran options we "use" gtk default if ( $TRAN ) { $j = substr($i,index($i,'_')); $j = "gtk$j"; $law{$i} = $law{$j}; $tmp_icon = $dmicon{$j}; $tmp_icon =~ s/\.png$/\.xpm/; $dmicon{$i} = "$TRAN_MINI_ICONS$tmp_icon"; } else { $dmicon{$i} = "$MINI_ICONS_DIR$dmicon{$i}"; } @list = split(':',$DI{$i}); $l = @list; while ( $l <= 5 ) { push(@list,''); ++$l } $law{$i} = $list[1] if ($list[1] eq 'no' || $list[1] eq 'ow' || $list[1] eq 're' || $list[1] eq 'dh' ); $dmicon{$i} = "$MINI_ICONS_DIR$list[0]" if ( $list[0] ne '' ); $place{$i} = '*' if ($list[2] eq 'up'); $dmicon{$i} = "$place{$i}$dmicon{$i}$place{$i}"; $dmicon{$i} = '' if ($law{$i} eq 'no' || $MINI_ICONS == 0); if ( $list[3] ne '' ) { $spic{$i} = "\@$list[3]\@" } else { $spic{$i} = '' } if ( $list[4] ne '' && $list[3] ne '' ) { $scolor{$i} = "\^$list[4]\^" } else {$scolor{$i} = ''}; } } # style init if ( $TRAN_STYLE ) { $STYLE = 1 } if ( $STYLE ) { @list= split(':',$ICON_STYLE); $l = @list; while ( $l <= 4 ) { push(@list,''); ++$l } if ( $TRAN_STYLE || $TRAN ) { if ( $list[0] ne '' ) { $dstyle{mini_icon} = $TRAN_MINI_ICONS . $list[0] } else { $dstyle{mini_icon} = $TRAN_MINI_ICONS . $dstyle{gnome_mini_icon} } if ( $list[1] ne '' ) { $dstyle{icon} = $TRAN_ICONS . $list[1] } else { $dstyle{icon} = $TRAN_ICONS . $dstyle{gnome_icon} } } else { if ( $list[0] ne '' ) { $dstyle{mini_icon} = $MINI_ICONS_DIR . $list[0] } else { $dstyle{mini_icon} = $MINI_ICONS_DIR . $dstyle{mini_icon} } if ( $list[1] ne '' ) { $dstyle{icon} = $ICONS_DIR . $list[1] } else { $dstyle{icon} = $ICONS_DIR . $dstyle{icon} } } $style_law = $list[2] if ( $list[2] eq 'dh' || $list[2] eq 'ow' || $list[2] eq 're' ); $addstyle = $list[3] if ( $list[3] ne '' ); } if ($checkMiniIcons ne "") { @checkMiniIconsPath = split(":",$checkMiniIcons); } if ($checkIcons ne "") { @checkIconsPath = split(":",$checkIcons); } #---------------- # LANG init for UTF-8 if ($UTF8) { # check if we have perl >= 5.6 if ($] < 5.006) { $UTF8_TR = ""; } else { my $l = substr($LANG,0,2); # latin-1: not sure that all these lang are "latin1"! $UTF8_TR = '$tmpLabel =~ tr/\0-\x{ff}//UC' if " ca de es it fr gl hu is lt nl no pt sv " =~ / $l /; } } if ($UNICONV ne "") { # check whether internal method is available if ($UNICONV_EXEC eq "" || $UNICONV_EXEC eq "internal") { eval "use Encode 'from_to';"; if ($UNICONV_EXEC eq "internal" && $@) { die "You don't have a good perl version to use" . " 'internal' unicode conversion:\n$@"; } $UNICONV_EXEC = $@? "iconv": "internal"; } # setup unicode conversion if ($UNICONV_EXEC eq "iconv") { die "iconv not found in your path\n" unless check_app("iconv"); $UTF8_TR = q{ $tmpLabel =~ s/'/'\\\\''/g; open(U, "echo '$tmpLabel' | iconv -f UTF8 -t $UNICONV |"); while () { chomp; $tmpLabel = $_ } close(U); }; } elsif ($UNICONV_EXEC eq "uniconv") { die "uniconv not found in your path\n" unless check_app("uniconv"); $UTF8_TR = q{ $tmpLabel =~ s/'/'\\\\''/g; open(U, "echo '$tmpLabel' | uniconv -I UTF8 -O $UNICONV |"); while () { chomp; $tmpLabel = $_ } close(U); }; } elsif ($UNICONV_EXEC eq "internal") { $UTF8_TR = 'from_to($tmpLabel, "utf-8", "$UNICONV")'; } else { die "--uniconv argument must be iconv, uniconv or internal\n"; } $UTF8 = 1; } #---------------- # "Main" variable: contains the directories to look at. # + is the "level" separator, the menu is built level by level # with a double loop if ($mergeUserMenu && -d $mergeUserDir) { @Rec_Dir_List = ("$mergeUserDir","+"); } else { @Rec_Dir_List = ("$APPS_DIR", "+"); $userMenuDone = 1; $mergeUserMenu = 0; } # init level # what is the function count("/", $dir) ? $level = 0; $cdir = $APPS_DIR; while ( $cdir =~ /\// ) { $cdir =~ s/\///; ++$level; } $top_level = $level; $nlevel = $level +1; # next level my $isTopLevel = 1; #--------------------------------- # Main loop (double loop) while( $Rec_Dir_List[0] ne '+') { # construct a level (may add some .fvwm2rc comment here) while( $Rec_Dir_List[0] ne '+') { $dir = $Rec_Dir_List[0]; # current working directory @Main_List=(); # will contain the list of the file and dir # # of $dir (in good order) my $hidden = 0; my @orderedList = (); my @newDirList = (); my @sList = (); my @uList = (); my @sDir = (); my @uDir = (); my @list = (); if ($mergeUserMenu) { $mergeDir = $dir; $sysDir = $dir; $mergeDir =~ s#^$APPS_DIR#$mergeUserDir#; $sysDir =~ s#^$mergeUserDir#$APPS_DIR#; if ("$sysDir" eq "$dir") { $mergeDirType = "s"; } else { $mergeDirType = "u"; } } #-------- # Construct the Main_List: # 1. look at an "order" hint and begin the list # 2. complete the list # 1. Look to the desktop order hint # For gnome there is an .order file. For kde the order is in the # .directory file. # for gnome if ( -f "$dir/.order" ) { open(ORDER, "$dir/.order") || print STDERR "fvwm-menu-desktop: Can't open $dir/.order: $!\n"; while( defined ($name = )) { chomp($name); push(@orderedList, "$dir/$name"); } close(ORDER); } # for kde # see if the user has over read the systeme .directory: if ("$mergeDirType" eq "s" && -f "$mergeDir/.directory") { open(ORDER, "$mergeDir/.directory") || print STDERR "fvwm-menu-desktop: Can't open $mergeDir/.directory: $!\n"; while() { $hidden = 1 if /^hidden=true/i; if ( /^SortOrder=(.*)$/ ) { @orderedList = (); $order = "$1"; @list = split(/\s*,\s*/, "$order"); foreach $name (@list) { next if -f "$mergeDir/$name" && isHidden("$mergeDir/$name"); push(@orderedList, "$dir/$name"); } } } close(ORDER); } elsif ( -f "$dir/.directory" ) { open(ORDER, "$dir/.directory") || print STDERR "fvwm-menu-desktop: Can't open $dir/.directory: $!\n"; while() { $hidden = 1 if /^hidden=true/i; if ( /^SortOrder=(.*)$/ ) { @orderedList = (); $order = "$1"; @list = split(/\s*[,;]\s*/, "$order"); foreach $name (@list) { next if $mergeUserMenu && -f "$mergeDir/$name" && isHidden("$mergeDir/$name"); push(@orderedList, "$dir/$name"); } } } close(ORDER); } @orderedList = () if $hidden; # 2. Add to @Main_List the items not in the order. # AND WE UPDATE @Rec_Dir_List HERE # a system submenu has a submenu in the user menu: if ($mergeDirType eq "s" && ! -d $dir && -d $mergeDir) { foreach $name (orderReadDir("$mergeDir")) { next if $name =~ /^\./; $add = (-f "$dir/$name") || isDirNonEmpty("$dir/$name"); if (-d "$mergeDir/$name") { next if -f "$mergeDir/$name/.directory" && isHidden("$mergeDir/$name/.directory"); push(@uDir, "$dir/$name") if $add; } foreach $j (@orderedList) { $add=0 if "$dir/$name" eq "$j"; } push(@uList, "$dir/$name") if $add ; } } if (-d $dir) { foreach $name (orderReadDir("$dir")) { next if $name =~ /^\./; $add = (-f "$dir/$name") || isDirNonEmpty("$dir/$name"); if ( -d "$dir/$name" ) { if ($mergeDirType eq "s" && -f "$mergeDir/$name/.directory") { next if isHidden("$mergeDir/$name/.directory"); } elsif ($mergeDirType eq "u" && -d "$sysDir/$name") { next; } elsif ( -f "$dir/$name/.directory") { next if isHidden("$dir/$name/.directory"); } push(@sDir, "$dir/$name") if $add; } elsif ($mergeDirType eq "s" && -f "$mergeDir/$name") { next if isHidden("$mergeDir/$name"); } foreach $j (@orderedList) { $add=0 if ("$dir/$name" eq "$j"); } push(@sList, "$dir/$name") if $add; } close(DIR); } # added user entries in a "system" submenu if ($mergeDirType eq "s" && -d "$mergeDir") { foreach $name (orderReadDir("$mergeDir")) { next if $name =~ /^\./; next if -d "$dir/$name" || -f "$dir/$name"; next if "$dir" eq "$APPS_DIR"; if (-d "$mergeDir/$name") { push(@uDir, "$dir/$name") if -d "$mergeDir/$name"; } elsif (-f "$mergeDir/$name") { next if isHidden("$mergeDir/$name"); } $add = 1; foreach $j (@orderedList) { $add=0 if ("$dir/$name" eq "$j"); } push(@uList, "$dir/$name") if $add; } } # --------- # Build the menu of $dir if (!$hidden) { push @Rec_Dir_List, @uDir, @sDir; push @Main_List, @orderedList, @uList, @sList; build_a_level(); } shift(@Rec_Dir_List); } # next level $isTopLevel = 0; $level = $nlevel; ++$nlevel; shift @Rec_Dir_List; # push out the "+" push( @Rec_Dir_List, '+' ); # add a level separator if ($mergeUserMenu && $Rec_Dir_List[0] eq '+' && !$userMenuDone) { $userMenuDone = 1; $isTopLevel = 1; @Rec_Dir_List = ("$APPS_DIR", "+"); } # @Rec_Dir_List = (+) => END } # output the style print "$STYLEOUTPUT" if ( $STYLE ); # output the menu style if ($MENU_STYLE ne "") { foreach (@menusForStyle) { print qq(ChangeMenuStyle "$MENU_STYLE" "$_"\n); } } # end of main #---------------------------------------------------------------------------- #---------------------------------------------------------------------------- # Subroutines: # orderReadDir # isHidden # up_directory # build_a_level (build a (sub)Menu) # get_info (Read Desktop hints, compute icons) # update_style # check_app # #---------------------------------------------------------------------------- #---------------------------------------------------------------------------- # sub orderReadDir { my $dir = shift; opendir(DIR,"$dir") || return (); # put the dirs first ... my @f = (); my @d = (); my @l = (); foreach $name (readdir(DIR)) { next if $name =~ /^\./; if (-d "$dir/$name") { push (@d, "$name"); } elsif (-f "$dir/$name") { push (@f, "$name"); } } close(DIR); return (@d, @f); } sub isDirNonEmpty { my $dir = shift; return 0 if (! -d $dir); opendir(DIR,"$dir") || return 0; foreach $name (readdir(DIR)) { next if $name =~ /^\./; close(DIR); return 1; } return 0; } sub isHidden { my $file = shift; my $return = 0; return 0 if ! -f $file; open(ISHIDDEN, "$file") || print STDERR "fvwm-menu-desktop: Can't open $mergeDir/$file"; while() { $return = 1 if /^hidden=true/i; } close(ISHIDDEN); return $return; } # Compute cd .. sub up_directory { my($dir) = @_; if ( $dir eq '' ) { return '../' } chop($dir); if ( ! ($dir =~ /\//) ) { return '' } $dir = substr($dir,0,rindex($dir,'/')+1); return $dir; } #---------------------------------------------------------------------------- # Build a (sub)menu sub build_a_level { my ($label, $exec, $mini_icon) = ('', '', ''); my ($style_mini_icon,$style_icon) = ('', ''); my $titletype; my $tmp_name; my $name; my $item; # Head of the menu # if ( $level == $top_level ) { if ($isTopLevel) { $mini_icon = $dmicon{$flag .'toptitle'}; $name = $MENU_NAME; if ($mergeDirType eq "s" && -r "$mergeDir/.directory") { ($label, $mini_icon) = get_info("$mergeDir/.directory", 'toptitle') } if (-r "$dir/.directory") { ($label, $mini_icon) = get_info("$APPS_DIR/.directory", 'toptitle') } if ( $label eq '' || $OPT_MENU_TITLE ne '') { $label = $MENU_TITLE } else { $label = "$DESKTOP $label" } $titletype = 'toptitle'; } else { $tmp_name = substr($dir,rindex ($dir,'/')+1); $name = "$SUBMENUS_PREFIX$tmp_name-$level"; $mini_icon = $dmicon{$flag . 'title'}; if ($mergeDirType eq "s" && -r "$mergeDir/.directory") { ($label, $mini_icon) = get_info("$mergeDir/.directory", 'title'); } if (-r "$dir/.directory") { ($label, $mini_icon) = get_info("$dir/.directory", 'title'); } $label = $tmp_name if ( $label eq ''); $titletype = 'title'; } # Now we can print the Head of the (sub)menu if (!($isTopLevel && $mergeUserMenu && $userMenuDone)) { if ( $flag eq 'gtk_' ) { printModuleConfig qq(Destroy "$name") if ( $level == $top_level && $MENU_DESTROY =~ /^y/ ); printModuleConfig qq(Menu "$name"), qq(Title "$label" $mini_icon), qq(Separator); } else { # if ( $level != $top_level || $MENU_DESTROY =~ /^y/ ) { if ( (!$isTopLevel || $MENU_DESTROY =~ /^y/) ) { print "DestroyMenu \"$name\"\n"; } elsif ( $MENU_DESTROY =~ /^d/ ) { print "DestroyMenu recreate \"$name\"\n"; } print "AddToMenu \"$name$spic{\"$flag$titletype\"}" . "$scolor{\"$flag$titletype\"}\" \"$label$mini_icon\" Title\n"; push @menusForStyle, $name; } } else { if ( $flag eq 'gtk_' ) { printModuleConfig qq(Menu "$name"); } else { print "AddToMenu \"$name\" \n"; } } # Items of the menu for $item (@Main_List) { #PB (good place ??) if ( time - $startime >= $timelimit ) { die "fvwm-menu-desktop runs longer than time-limit; dying (see the man page)\n"; } $label = ''; $tmp_name = substr($item,rindex ($item,'/')+1); my $itemDD = "$item/.directory"; if ($mergeDirType eq "s" && -r "$mergeDir/$tmp_name") { $item = "$mergeDir/$tmp_name"; $itemDD = "$item/.directory" if -r "$item/.directory"; } # If it is a dir --> a pop up (folder) if ( -d "$item" ) { $name = "$SUBMENUS_PREFIX$tmp_name-$nlevel"; ($label, $mini_icon) = get_info("$itemDD", 'folder') if (-r "$itemDD"); $label= $tmp_name if ( $label eq ""); if ( $flag eq 'gtk_' ) { printModuleConfig qq(Destroy "$name"), qq(SubMenu "$label" "$name" $mini_icon); } else { print "+ \"$label$mini_icon\" Popup \"$name\"\n"; } } # a file --> application $exec = ''; if (-r $item ) { ($name, $mini_icon, $exec) = get_info($item, 'app'); } if ( $exec ne '' ) { if ( $flag eq 'gtk_' ) { printModuleConfig qq(Item "$name" "Exec exec $exec" $mini_icon); } else { print "+ \"$name$mini_icon\" Exec exec $exec\n"; } } # for kde if ( $item eq "$dir/SEPARATOR") { if ( $flag eq 'gtk_' ) { printModuleConfig "Separator"; } else { print qq(+ "" Nop\n); } } } } # --------------------------------------------------------------------------- # Read Desktop hints, compute the (mini-)icon and build the STYLE (via a sub) sub get_info { my($file,$which) = @_; my($label, $mini_icon, $exec) = ('', '', '', ''); my($icon, $tran_icon, $tran_mini_icon) = ('', '', '', ''); my $term = 0; my($deflabel, $onelabel) = ('', ''); my $exec_exec = ''; my($style_icon, $style_mini_icon) = ('', ''); open(DESC,$file) || die "fvwm-menu-desktop: can't open $file: $!"; while() { if ( /^Name\[$LANG.*\]\s*=\s*(.*)$/ ) { $label = $1; if ($UTF8) { my $tmpLabel = $label; if ($UTF8_TR ne "") { eval $UTF8_TR; $label = $tmpLabel } else { $label = ""; } } #$label =~ s/%/%%/g; #$label =~ s/&/&&/g; #$label =~ s/\*/\*\*/g; next; } if (/^Name\s*=\s*(.*)$/) { $deflabel = $1; if ($UTF8) { my $tmpLabel = $deflabel; # needed for user menu! if ($UTF8_TR ne "") { eval $UTF8_TR; $deflabel = $tmpLabel } } next; } # Mandrake creates lines like: # Exec=NO_XALF command args... if ( /^Exec\s*=\s*NO_XALF\s*((\S*).*$)/ ) { print STDERR "FOUND X_ALF EXEC $1 EXEC_EXEC $2\n"; $exec = $1; $exec_exec = $2; next; } if ( /^Exec\s*=\s*((\S*).*$)/ ) { $exec = $1; $exec_exec = $2; next; } if (/^Terminal\s*=\s*1/) { $term = 1; next; } if ( /^Icon=(.*)$/ ) { $icon = substr($1,rindex($1,'/')+1); next; } # kde gives sometimes a mini-icon hint if ( /^MiniIcon=(.*)$/ ) { $mini_icon = substr($1,rindex($1,'/')+1); next; } } close(DESC); # kde2 give just the name of the icons and use png icons # try a more general fix. my $tmp = "png"; $icon = "$icon.$tmp" if $icon !~ /\....$/ && $icon ne ''; $mini_icon = "$mini_icon.$tmp" if $mini_icon !~ /\....$/ && $mini_icon ne ''; #print STDERR "$icon,$mini_icon\n"; #---------------------- # See which info we get $label = $deflabel if ( $label eq ''); $label = $onelabel if ( $label eq ''); if ( $which eq 'app' ) { # kde introduce some %foo things after the executable for options # "%c" is for the name (caption option) # other things seems useless for us ! # (%i is for icon, %m is for mini-icon, %u is for ??user?? and # %f is for file I presume, but what file ???) # we use caption $exec =~ s/\"\%c\"/\"$label\"/; $exec =~ s/\%.//g; # check the existence of the app return('', '', '') if $CHECK && !check_app($exec_exec); # term $exec = "$TERM_CMD $exec" if $term; #sometimes kde workers forget the icons and the mini-icons: if ( $mini_icon eq '' && $APPS_DIR eq $KDE_APPS) { $mini_icon = "$exec_exec.xpm" if ( -f "$KDE_MINI_ICONS$exec_exec.xpm"); $mini_icon = "$exec_exec.png" if ( -f "$KDE3_MINI_ICONS$exec_exec.png"); $icon = "$exec_exec.xpm" if ( -f "$KDE_ICONS$exec_exec.xpm" ); $icon = "$exec_exec.png" if ( -f "$KDE3_ICONS$exec_exec.png" ); } } #---------------------------- # if no icons or ow and no style we can return now return($label, $dmicon{$flag . $which}, $exec) if ( ($law{"$flag$which"} eq 'ow' || $law{"$flag$which"} eq 'no' || !$MINI_ICONS) && !$STYLE ); #-------------- # now the icons $mini_icon = $icon if ( $mini_icon eq ''); $icon = $mini_icon if ( $icon eq ''); # Translation # for mini-icons-tran && style(-tran) (we translate only the mini-icon # since gnome do not specify mini icon ...). if ( ($TRAN && $flag eq 'fvwm_') || ($TRAN_STYLE) ) { $tmp_icon = $mini_icon; if ( $tmp_icon =~ /\.png$/ ) { $tmp_icon =~ s/\.png$/\.xpm/; $tran_mini_icon = $tmp_icon if ( (-f "$TRAN_MINI_ICONS$tmp_icon") || !($TRAN_MINI_ICONS =~ /^\//) ); $tran_icon = $tmp_icon if ( (-f "$TRAN_ICONS$tran_mini_icon") || !($TRAN_ICONS =~ /^\//) ); } } # no .png icons with fvwm menu #$mini_icon = '' if ( $flag eq 'fvwm_' && $mini_icon =~ /\.png$/ ); if ($checkMiniIcons ne "" && $mini_icon ne "") { my $ok = 0; my $d; foreach $d (@checkMiniIconsPath) { $ok = 1 if -f "$d/mini_icon"; } $mini_icon = "" if !$ok; } if ($checkIcons ne "" && $icon ne "") { my $ok = 0; my $d; foreach $d (@checkIconsPath) { $ok = 1 if -f "$d/icon"; } $icon = "" if !$ok; } # Ok the icons are computed except the path. # Style if ( $STYLE && $which eq 'app' ) { if ( $tran_mini_icon ne '' ) { $style_mini_icon = $tran_mini_icon; } else { $style_mini_icon = $mini_icon; } if ( $tran_icon ne '' ) { $style_icon = $tran_icon } else { $style_icon = $icon; } update_style($style_mini_icon, $style_icon, $exec_exec) } # Add the path if ( $TRAN && $tran_mini_icon ne '' ) { $mini_icon = "$TRAN_MINI_ICONS$tran_mini_icon"; } elsif ( $mini_icon ne '' ) { $mini_icon = "$MINI_ICONS_DIR$mini_icon"; if ( $mini_icon =~ /\.png$/ ) { $mini_icon = "$PNG_ICONS$mini_icon" } else { $mini_icon = "$MINI_ICONS_DIR$mini_icon" } } #return the info with icon return($label, $dmicon{$flag . $which}, $exec) if ( $law{"$flag$which"} eq 'ow' || $law{"$flag$which"} eq 'no' || $MINI_ICONS == 0 || ($mini_icon eq '' && $law{"$flag$which"} eq 're') ); return($label, $mini_icon, $exec) if ($flag eq 'gtk_'); return($label, "$place{\"$flag$which\"}$mini_icon$place{\"$flag$which\"}",$exec) if $mini_icon ne ''; return($label, '', $exec); } # --------------------------------------------------------------------------- # Update style sub update_style { my($style_mini_icon, $style_icon, $exec_exec) = @_; # Gnome exception for $exec_exec, I probably forget some ... # seems that there is a rule ... $exec_exec = 'GnomeTerminal' if ( $exec_exec eq 'gnome-terminal' ); $exec_exec = 'Imlib Config Editor' if ( $exec_exec eq 'imlib_config' ); $exec_exec = 'GnomeHelpBrowser' if ( $exec_exec eq 'gnome-help-browser' ); $exec_exec = 'GQview' if ( $exec_exec eq 'gqview' ); # kde exceptions. Some families of apps have the same name, class, resource # for windows manager, but kwm; (I try the caption and icon option with # kcminfo but do not succeed ...) # Anyway some of the concerned applications are kwm specifics. if ( $exec_exec eq 'kfmclient' ) { $style_icon = $style_mini_icon = 'kfm.xpm'; #kfm_home.xpm better ??? $exec_exec = 'kfm'; } $style_icon = $style_mini_icon = 'information_settings.xpm' if ( $exec_exec =~ /^kcminfo/ ); $style_icon = $style_mini_icon = 'kcmkwm.xpm' if ( $exec_exec =~ /^kcmdisplay/ ); $style_icon = $style_mini_icon = 'input_device_settings.xpm' if ( $exec_exec =~ /^kcminput/ ); $style_icon = $style_mini_icon = 'kwm.xpm' if ( $exec_exec =~ /^kcmkwm/ ); # Now we add the good path if ( $TRAN_STYLE || $TRAN ) { $style_mini_icon = "$TRAN_MINI_ICONS$style_mini_icon" if ( $style_mini_icon ne ''); $style_icon = "$TRAN_ICONS$style_icon" if ( $style_icon ne ''); } else { $style_mini_icon = "$MINI_ICONS_DIR$style_mini_icon" if ( $style_mini_icon ne '' ); $style_icon = "$ICONS_DIR$style_icon" if ( $style_icon ne '' ); } if (($style_mini_icon eq '' && $style_law eq 're') || ($style_law eq 'ow')) { $style_mini_icon = $dstyle{mini_icon}; } if (($style_icon eq '' && $style_law eq 're') || ($style_law eq 'ow')) { $style_icon = $dstyle{icon}; } # Update $STYLEOUTPUT if ( $style_mini_icon ne '' || $style_icon ne '' || $addstyle ne '' ) { $STYLEOUTPUT .= "Style \"$exec_exec\" MiniIcon " . "$style_mini_icon\n" if ( $style_mini_icon ne '' ); $STYLEOUTPUT .= "Style \"$exec_exec\" Icon $style_icon\n" if ( $style_icon ne '' ); $STYLEOUTPUT .= "Style \"$exec_exec\" $addstyle\n" if ( $addstyle ne '' ); } } #-------------------------------------------------------------------------- # Check if application binary is executable and reachable sub check_app { my($app) = @_; # If full path, dont use path, just check path if ( substr($app,0,1) eq '/' and -x $app ) { return 1 }; # Check if an application is in the path foreach $dir (@PATH_DIRS) { if ( -x "$dir/$app" ) { return 1 } } return 0; } #---------------------------------------------------------------------------- # Standard functions sub showHelp { print <