#!/usr/bin/perl

# Copyright (C) 2011-2013 Daniel "Trizen" Șuteu <echo dHJpemVueEBnbWFpbC5jb20K | base64 -d>.
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

# Program: menutray
# License: GPLv3
# Created on: 03 March 2011
# Latest edit on: 07 October 2013

# Websites: http://trizen.googlecode.com
#           http://trizenx.blogspot.com

use 5.014;
use Encode qw(decode_utf8);
use Linux::DesktopFiles 0.08;

my $pkgname = 'menutray';
my $version = '0.41';

my ($icons, $create_menu, $reconfigure, $stdout_config, $update_config);

our ($CONFIG, $SCHEMA);

my $home_dir =
     $ENV{HOME}
  || $ENV{LOGDIR}
  || (getpwuid($<))[7]
  || `echo -n ~`;

my $xdg_config_home = $ENV{XDG_CONFIG_HOME} || "$home_dir/.config";

my $config_dir  = "$xdg_config_home/$pkgname";
my $config_file = "$config_dir/config.pl";
my $schema_file = "$config_dir/schema.pl";
my $menufile    = "$config_dir/menu.pl";

sub usage {
    print <<"HELP";
usage: $0 [options]

Options :
    -g  : (re)generate a simple menu
    -i  : (re)generate a menu with icons
    -u  : update the configuration file
    -r  : rewrite the configuration files

Help:
    -h  : print this message
    -v  : print the version number
    -S  : print the schema file to STDOUT
    -H  : print help message for config files

* Menu   : $menufile
* Config : $config_file
* Schema : $schema_file\n
HELP
    exit 0;
}

my $config_help = <<"HELP";

|| FILTERING
    | skip_filename_re    : Skip a .desktop file if its name matches the regex.
                            Name is from the last slash to the end. (filename.desktop)
                            Example: qr/^(?:gimp|xterm)\\b/,    # skips 'gimp' and 'xterm'

    | skip_entry          : Skip a destkop file if the value from a given key matches the regex.
                            Example: [
                                {key => 'Name', re => qr/(?:about|terminal)/i},
                                {key => 'Exec', re => qr/^xterm/},
                            ],

    | substitutions       : Substitute, by using a regex, in the values of the desktop files.
                            Example: [
                                {key => 'Exec', re => qr/xterm/, value => 'sakura'},
                                {key => 'Exec', re => qr/\\\\\\\\/,  value => '\\\\', global => 1},    # for wine apps
                            ],


|| ICON SETTINGS
    | icon_type           : Menu icon type (menu, small-toolbar, large-toolbar, button, dialog)
    | icon_size           : Icon size in pixels (only for full path icons) (default: [16, 16])
    | missing_image       : Use this icon for missing icons (default: gtk-missing-image)


|| KEYS
    | tooltip_keys        : Valid keys for the tooltip text.
                            Example: ['Comment[es]', 'Comment'],

    | name_keys           : Valid keys for the item names.
                            Example: ['Name[fr]', 'GenericName[fr]', 'Name'],   # french menu


|| PATHS
    | desktop_files_paths   : Absolute paths which contains .desktop files.
                              Example: [
                                '/usr/share/applications',
                                "\$ENV{HOME}/.local/share/applications",
                                glob("\$ENV{HOME}/.local/share/applications/wine/Programs/*"),
                              ],


|| NOTES
    | Regular expressions:
        * use qr/RE/ instead of 'RE'
        * use qr/RE/i for case insenstive mode
HELP

my $schema_help = <<"HELP";
=> Main keys

    sep  => undef
    raw  => PERL_CODE
    item => [COMMAND, LABEL, ICON]
    cat  => [CATEGORY, LABEL, ICON]
    tree => [ARRAY_REF, LABEL, ICON]

=> Menutray's keys

    exit       => [LABEL, ICON]
    menutray   => [LABEL, ICON]
    regenerate => [LABEL, ICON]
    begin_cat  => [\$VAR, LABEL, ICON]
    end_cat    => [\$VAR]

=>> Examples

** For 'raw':

    {raw => <<'CODE'},
{

    # Create the main menu entry
    my \$entry = 'Gtk2::ImageMenuItem'->new('My menu');

    # Set icon
    \$entry->set_image('Gtk2::Image'->new_from_icon_name('applications-system','menu'));

    # Create the submenu
    my \$submenu = Gtk2::Menu->new;

    # Create a new menu item
    my \$item = Gtk2::ImageMenuItem->new('Terminal');

    # Set icon
    \$item->set_image('Gtk2::Image'->new_from_icon_name('terminal','menu'));

    # Set a signal (activates on click)
    \$item->signal_connect('activate',sub {system 'xterm &'});

    # Append the item to the submenu
    \$submenu->append(\$item);

    # Set the submenu to the entry item
    \$entry->set_submenu(\$submenu);

    # Append the entry to the main menu
    \$menu->append(\$entry);
}
CODE

** For 'tree':

    {
     tree => [
            [{
                Name => "Item name",
                Exec => "command",
                Icon => "icon-name",
            },
            #{
                # ...
            #},
            ],

            'My submenu', 'icon-name'
        ]
    },
HELP

sub full_help {
    print <<"HELP";
=>> Schema file:
$schema_help
====================================================

=>> Config file:
$config_help
HELP
    exit 0;
}

if (@ARGV) {
    while (defined(my $arg = shift @ARGV)) {
        if ($arg eq '-h' or $arg eq '--help' or $arg eq '-?') {
            usage();
        }
        elsif ($arg eq '-i') {
            $icons       = 1;
            $create_menu = 1;
        }
        elsif ($arg eq '-g') {
            $create_menu = 1;
        }
        elsif ($arg eq '-r') {
            $reconfigure = 1;
        }
        elsif ($arg eq '-u') {
            $update_config = 1;
        }
        elsif ($arg eq '-v') {
            print "$pkgname $version\n";
            exit;
        }
        elsif ($arg eq '-S') {
            $stdout_config = 1;
        }
        elsif ($arg eq '-H') {
            full_help();
        }
        else {
            warn "$0: Unknwon option: ${arg}\n";
        }
    }
}

if (not -d $config_dir) {
    require File::Path;
    File::Path::make_path($config_dir)
      or die "$0: Can't create directory '${config_dir}': $!";
}

my $config_documentation = <<"EOD";
#!/usr/bin/perl

# $pkgname - configuration file
# This file will be updated automatically every time when is needed.
# Any additional comment and/or indentation will be lost.

=for comment
$config_help
=cut

EOD

my %CONFIG = (
    'Linux::DesktopFiles' => {

        keep_empty_categories   => 0,
        keep_unknown_categories => 1,
        unknown_category_key    => 'other',

        skip_entry       => undef,
        substitutions    => undef,
        skip_filename_re => undef,

        terminalize            => 1,
        terminal               => 'xterm',
        terminalization_format => q{%s -e '%s'},

        desktop_files_paths => ['/usr/share/applications'],
    },

    set_tooltips => 1,

    name_keys    => ['Name'],
    tooltip_keys => ['Comment'],

    editor                 => 'geany',
    icon_type              => 'menu',
    icon_size              => [16, 16],
    missing_image          => 'gtk-missing-image',
    gdk_interpolation_type => 'hyper',

    VERSION => $version,
             );

sub dump_configuration {
    require Data::Dump;
    open my $config_fh, '>', $config_file
      or die "error: Can't open '${config_file}' for write: $!";
    my $dumped_config = q{our $CONFIG = } . Data::Dump::dump(\%CONFIG);
    print $config_fh $config_documentation, $dumped_config;
    close $config_fh;
}

if (not -e $config_file or $reconfigure) {
    dump_configuration();
}

if (not -e $schema_file or $reconfigure or $stdout_config) {

    my $schema_fh = $stdout_config ? \*STDOUT : do {
        open my $fh, '>', $schema_file
          or die "Can't open file '${schema_file}' for write: $!";
        $fh;
    };

    print $schema_fh <<"SCHEMA_FILE";
#!/usr/bin/perl

# $pkgname - schema file

=for comment
$schema_help
=cut

# NOTE:
#    * Keys and values are case sensitive. Keep all keys lowercase.
#    * ICON can be a either a direct path to an icon or a valid icon name
#    * Category names are case insensitive. (X-XFCE and x_xfce are equivalent)

require '${config_file}';

our \$SCHEMA = [
    #          COMMAND             LABEL                ICON
    {item => ['pcmanfm',       'File Manager',      'file-manager']},
    {item => ['xterm',         'Terminal',          'terminal']},
    {item => ['google-chrome', 'Web Browser',       'web-browser']},
    {item => ['gmrun',         'Run command',       'system-run']},
    {item => ['pidgin',        'Instant messaging', 'system-users']},

    {sep => undef},

    #          NAME            LABEL                ICON
    {cat => ['utility',     'Accessories', 'applications-utilities']},
    {cat => ['development', 'Development', 'applications-development']},
    {cat => ['education',   'Education',   'applications-science']},
    {cat => ['game',        'Games',       'applications-games']},
    {cat => ['graphics',    'Graphics',    'applications-graphics']},
    {cat => ['audiovideo',  'Multimedia',  'applications-multimedia']},
    {cat => ['network',     'Network',     'applications-internet']},
    {cat => ['office',      'Office',      'applications-office']},
    {cat => ['other',       'Other',       'applications-other']},
    {cat => ['settings',    'Settings',    'applications-accessories']},
    {cat => ['system',      'System',      'applications-system']},

    #{cat => ['qt',          'QT Applications',    'qtlogo']},
    #{cat => ['gtk',         'GTK Applications',   'gnome-applications']},
    #{cat => ['x_xfce',      'XFCE Applications',  'applications-other']},
    #{cat => ['gnome',       'GNOME Applications', 'gnome-applications']},
    #{cat => ['consoleonly', 'CLI Applications',   'applications-utilities']},

    #                VAR_NAME       LABEL         ICON
    #{begin_cat => ['\$my_cat', 'My category', 'cat-icon']},
    #             ... some items ...
    #{end_cat   => '\$my_cat'},

    {menutray   => ['Menutray', 'preferences-desktop']},

    {sep        => undef},
    {regenerate => ['Regenerate', 'gtk-refresh']},
    {exit       => ['Exit', 'exit']},
]
SCHEMA_FILE

    exit if $stdout_config;
    close $schema_fh;
}

require $schema_file;    # Load the configuration files

# Remove user's defined values
my @valid_keys = grep exists $CONFIG{$_}, keys %{$CONFIG};
@CONFIG{@valid_keys} = @{$CONFIG}{@valid_keys};

# Keep user's defined values
#@CONFIG{keys %{$CONFIG}} = values %{$CONFIG};

if ($CONFIG{VERSION} != $version) {
    $update_config = 1;
    $CONFIG{VERSION} = $version;
}

my $desk_obj = Linux::DesktopFiles->new(
    %{$CONFIG{'Linux::DesktopFiles'}},

    home_dir   => $home_dir,
    categories => [map $_->{cat}[0], grep exists $_->{cat}, @$SCHEMA],

    keys_to_keep =>
      [@{$CONFIG{name_keys}}, 'Exec', $icons ? 'Icon' : (), $CONFIG{set_tooltips} ? @{$CONFIG{tooltip_keys}} : ()],

    case_insensitive_cats => 1,
                                       );

my $comment = '# # ' x 10;
my ($inside_cat, $generated_menu);

if ($create_menu) {
    generate_menu();
}

sub tooltip {

    my $var_name = shift;
    my $text     = decode_utf8(shift);

    <<"TOOLTIP";
    $var_name->set_property('tooltip_text', "\Q$text\E");
TOOLTIP
}

sub image_from_file {
    my ($var, $icon_filename) = @_;

    return <<"ICON_FROM_XPM" if $icon_filename =~ /\.xpm\z/i;
    $var->set_image('Gtk2::Image'->new_from_pixbuf('Gtk2::Gdk::Pixbuf'->new_from_file("\Q$icon_filename\E")->scale_simple($CONFIG{icon_size}[0],$CONFIG{icon_size}[1],q{$CONFIG{gdk_interpolation_type}})));
ICON_FROM_XPM

    return <<"ICON_FROM_FILE";
    $var->set_image('Gtk2::Image'->new_from_pixbuf('Gtk2::Gdk::Pixbuf'->new_from_file_at_size("\Q$icon_filename\E",$CONFIG{icon_size}[0],$CONFIG{icon_size}[1])));
ICON_FROM_FILE
}

sub image_from_icon_name {
    my ($var, $icon_name) = @_;
    <<"ICON_FROM_NAME";
    $var->set_image('Gtk2::Image'->new_from_icon_name("\Q$icon_name\E",q{$CONFIG{icon_type}}));
ICON_FROM_NAME
}

sub missing_image {
    my ($var) = @_;
    <<"ICON_FROM_STOCK";
    $var->set_image('Gtk2::Image'->new_from_stock(q{$CONFIG{missing_image}},q{$CONFIG{icon_type}}));
ICON_FROM_STOCK
}

sub system_command {
    my $var     = shift;
    my $command = decode_utf8(shift);
    <<"SIGNAL_CONNECT";
    $var->signal_connect('activate', sub {system "\Q$command\E &"});
SIGNAL_CONNECT
}

sub new_item {
    my $var   = shift;
    my $label = decode_utf8(shift);
    my $type  = $icons ? 'Gtk2::ImageMenuItem' : 'Gtk2::MenuItem';
    return <<"ITEM";
    my $var = '${type}'->new("\Q$label\E");
ITEM
}

sub select_icon {
    my ($var, $icon_name) = @_;

    if (defined($icon_name) and $icon_name ne q{}) {
        if (chr ord $icon_name eq '/') {
            return image_from_file($var, $icon_name);
        }
        else {
            return image_from_icon_name($var, $icon_name);
        }
    }

    missing_image($var);
}

sub begin_category {
    my ($var, $cat_name, $icon_name) = @_;

    $generated_menu .= <<"CATEGORY_HEADER" . new_item($var, $cat_name);
\n    $comment\U$cat_name\E $comment
{
    my \$apps = 'Gtk2::Menu'->new;
CATEGORY_HEADER

    if ($icons && defined($icon_name)) {
        $generated_menu .= select_icon($var, $icon_name);
    }

    return 1;
}

sub end_category {
    my ($var) = @_;
    <<"END_OF_CAT";
    $var->set_submenu(\$apps);
    \$menu->append($var);
}
END_OF_CAT
}

sub push_app {
    my (undef, $cat_name, $icon_name) = @_;

    my $cat_var = '$cat';
    begin_category($cat_var, $cat_name, $icon_name);

    $generated_menu .= join(
        q{},
        (
         map $_->[1],
         sort { $a->[0] cmp $b->[0] }
           map [lc($_) => $_],
         map {

             my $item;
             my $item_var = '$app';

             foreach my $nkey (@{$CONFIG{name_keys}}) {
                 if (defined $_->{$nkey}) {
                     $item = "{\n" . new_item($item_var, $_->{$nkey}) . system_command($item_var, $_->{Exec});
                     last;
                 }
             }

             if ($CONFIG{set_tooltips}) {
                 foreach my $tkey (@{$CONFIG{tooltip_keys}}) {
                     if (defined $_->{$tkey}) {
                         $item .= tooltip($item_var, $_->{$tkey});
                         last;
                     }
                 }
             }

             if ($icons) {
                 $item .= select_icon($item_var, $_->{Icon} || ($_->{Exec} =~ /^(\S+)/));
             }
             $item . <<"APPEND";
    \$apps->append($item_var);
}
APPEND
           } @{$_[0]}
        )
      )
      . end_category($cat_var);
    1;
}

sub add_item {
    my ($command, $name, $icon) = @_;

    my $var_name = '$item';
    $generated_menu .= "{\n" . new_item($var_name, $name);

    if ($icons && defined($icon)) {
        $generated_menu .= select_icon($var_name, $icon);
    }

    $generated_menu .= system_command($var_name, $command) . ($inside_cat ? <<"IN_SUBMENU" : <<"IN_MENU");
    \$apps->append($var_name);
}\n
IN_SUBMENU
    \$menu->append($var_name);
}\n
IN_MENU
    return 1;
}

sub generate_menu {
    $generated_menu = <<"HEADER";
#!/usr/bin/perl

# File generated by $pkgname v$version

# DO NOT edit this file!
# Any change in this file will be lost!
# Edit '$schema_file' instead!

use utf8;
use Gtk2 ('-init');

my \$menu = 'Gtk2::Menu'->new;
my \$icon = 'Gtk2::StatusIcon'->new;

\$icon->set_from_icon_name('start-here');
\$icon->set_visible(1);
\$icon->signal_connect('button-release-event', \\&show_icon_menu);
\$icon->set_tooltip('Click for menu...');

load_menu();

sub show_icon_menu {
    \$menu->popup(undef, undef, sub {return Gtk2::StatusIcon::position_menu(\$menu, 0, 0, \$icon)}, [1, 1], 0, 0);
    return 1;
}

sub load_menu {
HEADER

    my $categories = $desk_obj->parse_desktop_files;

    foreach my $schema (@$SCHEMA) {
        if (exists $schema->{cat}) {
            exists($categories->{my $category = lc($schema->{cat}[0]) =~ tr/_a-z0-9/_/cr}) || next;
            push_app(\@{$categories->{$category}}, $schema->{cat}[1], $schema->{cat}[2]);
        }
        elsif (exists $schema->{item}) {
            add_item(@{$schema->{item}});
        }
        elsif (exists $schema->{menutray}) {
            my ($label, $icon) = @{$schema->{menutray}};
            push_app(
                     [{Exec => "$CONFIG{editor} $menufile",    Name => "Open the menu file",   Icon => $icon},
                      {Exec => "$CONFIG{editor} $config_file", Name => "Open the config file", Icon => $icon},
                      {Exec => "$CONFIG{editor} $schema_file", Name => "Open the schema file", Icon => $icon},
                     ],
                     $label, $icon
                    );
        }
        elsif (exists $schema->{begin_cat}) {
            $inside_cat = 1;
            begin_category(@{$schema->{begin_cat}});
        }
        elsif (exists $schema->{end_cat}) {
            $inside_cat = 0;
            $generated_menu .= end_category($schema->{end_cat});
        }
        elsif (exists $schema->{tree}) {
            push_app(@{$schema->{tree}});
        }
        elsif (exists $schema->{exit}) {
            my ($name, $icon) = @{$schema->{exit}};

            my $var_name = "\$quit";
            $generated_menu .= "{\n" . new_item($var_name, $name);

            if ($CONFIG{set_tooltips}) {
                $generated_menu .= tooltip($var_name, "Close this application.");
            }

            if ($icons && defined($icon)) {
                $generated_menu .= select_icon($var_name, $icon);
            }

            $generated_menu .= <<"QUIT";
    $var_name->signal_connect('activate', sub { Gtk2->main_quit; exit });
    \$menu->append($var_name);
}
QUIT
        }
        elsif (exists $schema->{regenerate}) {
            my ($name, $icon) = @{$schema->{regenerate}};

            require Cwd;
            my $regenerate_exec = join(q{ }, $^X, quotemeta(Cwd::abs_path($0)), $icons ? '-i' : '-g');

            my $var_name = "\$regenerate";
            $generated_menu .= "{\n" . new_item($var_name, $name);

            if ($CONFIG{set_tooltips}) {
                $generated_menu .= tooltip($var_name, "Regenerate this menu.");
            }

            if ($icons && defined($icon)) {
                $generated_menu .= select_icon($var_name, $icon);
            }

            $generated_menu .= <<"REGENERATE_ITEM";
    $var_name->signal_connect('activate', sub {system "\Q$regenerate_exec\E &"; 'Gtk2'->main_quit; exit});
    \$menu->append($var_name);
}
REGENERATE_ITEM
        }
        elsif (exists $schema->{raw}) {
            $generated_menu .= $schema->{raw};
        }
        elsif (exists $schema->{sep}) {
            $generated_menu .= <<"SEPARATOR";
\n    \$menu->append('Gtk2::SeparatorMenuItem'->new);
SEPARATOR
        }
    }

    $generated_menu .= <<'FOOTER';
    $menu->show_all;
    return 1;
}
'Gtk2'->main;
FOOTER

    open my $menu_fh, '>:encoding(UTF-8)', $menufile
      or die "$0: Can't open file '${menufile}' for write: $!";
    print $menu_fh $generated_menu;
    close $menu_fh;
}

dump_configuration() if $update_config;

-f $menufile ? (do($menufile) || warn "$0: Can't run the menu file '${menufile}': $!") : usage();
