#!/usr/bin/perl
#
# Copyright (C) 2010-2021 Daniel "Trizen" Șuteu <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | 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/>.
#

# Author: Daniel "Trizen" Șuteu
# License: GPLv3
# Created: 03 March 2011
# Latest edit: 23 August 2021

# Contributor(s):
#   andrei-a-papou - https://github.com/andrei-a-papou

# Websites:
#   https://github.com/trizen/menutray
#   https://trizenx.blogspot.com/2012/02/menutray.html

use 5.014;
use warnings;

use File::Spec qw();
use Encode qw(encode_utf8 decode_utf8);
use Linux::DesktopFiles 0.25;

my $pkgname = 'menutray';
my $version = '0.54';
my $GTK     = 'Gtk3';       # Version of GTK+

my $depth = 0;              # current submenu depth
my $menu  = '$menu';        # current submenu name

my ($with_icons, $create_menu, $reconfigure, $update_config);

our ($CONFIG, $SCHEMA);

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

my $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 $menu_file   = "$config_dir/menu.pl";

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

options:
    -g  : generate a simple menu
    -i  : generate a menu with icons
    -u  : update the configuration file
    -r  : regenerate the configuration file

other:
    -S <file>  : path to the schema.pl file
    -C <file>  : path to the config.pl file
    -o <file>  : path to the menu.pl file

help:
    -h  : print this message and exit
    -v  : print version number and exit

* Menu   : $menu_file
* Config : $config_file
* Schema : $schema_file\n
HELP
}

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. (e.g.: 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 => 'tilix'},
                            ],

|| ICON SETTINGS
    | gtk_version         : The version of the Gtk library used for the menu. (default: 3)
    | icon_type           : Menu icon type (menu, dnd, small-toolbar, large-toolbar, button, dialog)
    | icon_size           : Icon size in pixels (only for absolute icon paths) (default: [16, 16])
    | missing_image       : Use this icon for missing icons (default: gtk-missing-image)

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

if (@ARGV) {
    while (defined(my $arg = shift @ARGV)) {
        if ($arg eq '-i') {
            $with_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 0;
        }
        elsif ($arg eq '-S') {
            $schema_file = shift(@ARGV) // die "$0: option '-S' requires an argument!\n";
        }
        elsif ($arg eq '-C') {
            $config_file = shift(@ARGV) // die "$0: options '-C' requires an argument!\n";
        }
        elsif ($arg eq '-o') {
            $menu_file = shift(@ARGV) // die "$0: option '-o' requires an argument!\n";
        }
        elsif ($arg eq '-h' or $arg eq '--help' or $arg eq '-?') {
            output_usage();
            exit 0;
        }
        else {
            die "$0: option `$arg' is invalid!\n";
        }
    }
}

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

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

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

=for comment
$config_help
=cut

EOD

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

        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',
            '/usr/local/share/applications',
            '/usr/share/applications/kde4',
            "$home_dir/.local/share/applications",
        ],
#>>>
    },

    gtk_version      => 3,
    tooltips         => 1,
    locale_support   => 1,
    popup_at_cursor  => 0,
    editor           => 'geany',
    icon_type        => 'menu',
    icon_size        => [16, 16],
    missing_image    => 'gtk-missing-image',
    menutray_icon    => 'start-here',
    menutray_title   => 'menutray',
    menutray_tooltip => 'Applications',
    VERSION          => $version,
             );

sub dump_configuration {
    require Data::Dump;
    open my $config_fh, '>', $config_file
      or die "Can't open file '${config_file}' for write: $!";
    my $dumped_config = q{our $CONFIG = } . Data::Dump::dump(\%CONFIG) . "\n";
    $dumped_config =~ s/\Q$home_dir\E/\$ENV{HOME}/g if ($home_dir eq $ENV{HOME});
    print $config_fh $config_documentation, $dumped_config;
    close $config_fh;
}

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

if (not -e $schema_file) {
    if (-e (my $etc_schema_file = "/etc/xdg/$pkgname/schema.pl")) {
        require File::Copy;
        File::Copy::copy($etc_schema_file, $schema_file)
          or die "$0: can't copy file `$etc_schema_file' to `$schema_file': $!\n";
    }
    else {
        die "$0: schema file `$schema_file' does not exists!\n";
    }
}

foreach my $file (\$schema_file, \$config_file) {
    if (not File::Spec->file_name_is_absolute($$file)) {
        $$file = File::Spec->rel2abs($$file);
    }
}

# Load the configuration files
require $schema_file;
require $config_file;

# Remove invalid keys
my @valid_keys = grep exists $CONFIG{$_}, keys %$CONFIG;
@CONFIG{@valid_keys} = @{$CONFIG}{@valid_keys};

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

if ($CONFIG{gtk_version} == 2) {
    $GTK = "Gtk2";
}

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

    categories => [map { exists($_->{cat}) ? $_->{cat}[0] : () } @$SCHEMA],

    keys_to_keep => ['Name', 'Exec',
                     ($with_icons       ? 'Icon'    : ()),
                     ($CONFIG{tooltips} ? 'Comment' : ()),
                     (
                      ref($CONFIG{'Linux::DesktopFiles'}{skip_entry}) eq 'ARRAY'
                      ? (map { $_->{key} } @{$CONFIG{'Linux::DesktopFiles'}{skip_entry}})
                      : ()
                     ),
                    ],

    case_insensitive_cats => 1,
                                       );

my $comment        = '# # ' x 10;
my $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('${GTK}::Image'->new_from_pixbuf('${GTK}::Gdk::Pixbuf'->new_from_file("\Q$icon_filename\E")->scale_simple($CONFIG{icon_size}[0],$CONFIG{icon_size}[1],'hyper')));
ICON_FROM_XPM

    return <<"ICON_FROM_FILE";
    $var->set_image('${GTK}::Image'->new_from_pixbuf('${GTK}::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('${GTK}::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('${GTK}::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  = $with_icons ? "${GTK}::ImageMenuItem" : "${GTK}::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 ($cat_name, $icon_name) = @_;

    $generated_menu .= <<"CATEGORY_HEADER" . new_item('$app', $cat_name);
\n    $comment\U$cat_name\E $comment
{
    my \$menu$depth = '${GTK}::Menu'->new;
CATEGORY_HEADER

    if ($with_icons && defined($icon_name)) {
        $generated_menu .= select_icon('$app', $icon_name);
    }

    return 1;
}

sub end_category {

    $menu = '$menu' . (($depth - 1) || '');

    my $str = <<"END_OF_CAT";
    \$app->set_submenu(\$menu$depth);
    $menu->append(\$app);
}
END_OF_CAT

    $depth -= 1;
    return $str;
}

sub incr_depth {
    $depth += 1;
    $menu = '$menu' . $depth;
}

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

    incr_depth();

    my @menu_items;
    foreach my $entry (@{$entries}) {

        my $item_var = '$app';
        my $item     = "{\n" . new_item($item_var, $entry->{Name} // next) . system_command($item_var, $entry->{Exec} // next);

        if ($CONFIG{tooltips} and defined($entry->{Comment})) {
            $item .= tooltip($item_var, $entry->{Comment});
        }

        if ($with_icons) {
            $item .= select_icon($item_var, $entry->{Icon} || ($entry->{Exec} =~ /^(\S+)/));
        }

        push @menu_items, $item . <<"APPEND";
    \$menu$depth->append($item_var);
}
APPEND
    }

    @menu_items || return;    # skip creating empty categories

    begin_category($cat_name, $icon_name);

    $generated_menu .= (
                        join(
                             '', map $_->[1], sort { $a->[0] cmp $b->[0] }
                               map [lc($_) => $_], @menu_items
                            )
                          . end_category()
                       );
}

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

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

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

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

sub regenerate_item {
    my ($menu_var, $name, $icon) = @_;

    require Cwd;
    my $regenerate_exec = join(
                               ' ',
                               $^X, quotemeta(Cwd::abs_path($0)),
                               ($with_icons    ? '-i'    : '-g'),
                               '-C' => quotemeta(Cwd::abs_path($config_file)),
                               '-S' => quotemeta(Cwd::abs_path($schema_file)),
                               '-o' => quotemeta(Cwd::abs_path($menu_file)),
                              );

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

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

    if ($with_icons && defined($icon)) {
        $source .= select_icon($var_name, $icon);
    }

    $source .= <<"REGENERATE_ITEM";
    $var_name->signal_connect('activate', sub {system "\Q$regenerate_exec\E &"; '${GTK}'->main_quit});
    $menu_var->append($var_name);
}
REGENERATE_ITEM

    return $source;
}

sub quit_item {
    my ($menu_var, $name, $icon) = @_;

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

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

    if ($with_icons && defined($icon)) {
        $source .= select_icon($var_name, $icon);
    }

    $source .= <<"QUIT_ITEM";
    $var_name->signal_connect('activate', sub { '${GTK}'->main_quit });
    $menu_var->append($var_name);
}
QUIT_ITEM

    return $source;
}

sub popup_menu {
    my ($menu_var) = @_;
    <<"POPUP";
$menu_var->popup(undef, undef, sub {
            my (\$x, \$y, \@list) = ${GTK}::StatusIcon::position_menu($menu_var, 0, 0, \$icon);
            if ($CONFIG{popup_at_cursor}) {
                (\$x, \$y) = \@_[1,2];
                if (${\($GTK eq 'Gtk2' ? 1 : 0)}) {
                    $menu_var->set_monitor(Gtk2::Gdk::Screen->get_default->get_monitor_at_point(\$x, \$y));
                } else {
                    $menu_var->set_monitor(Gtk3::Gdk::Screen::get_default()->get_monitor_at_point(\$x, \$y));
                }
            }
            (\$x, \$y, \@list);
        }, [1, 1], 0, 0);
POPUP
}

sub generate_menu {

    my $schema_file_relative = $schema_file;

    if ($home_dir eq $ENV{HOME}) {
        $schema_file_relative =~ s/\Q$home_dir\E/~/;
    }

    $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_relative instead!

use utf8;
use strict;
use $GTK ('-init');

my \$menu = '${GTK}::Menu'->new;
my \$icon = '${GTK}::StatusIcon'->new;

my \$menutray_title   = "\Q$CONFIG{menutray_title}\E";
my \$menutray_tooltip = "\Q$CONFIG{menutray_tooltip}\E";

if (defined(\$menutray_title) and ${\($GTK eq 'Gtk2' ? 1 : 0)}) {
    \$icon->set_title(\$menutray_title);
    \$icon->set_name('');
}

if (defined(\$menutray_tooltip) and ${\($GTK eq 'Gtk2' ? 1 : 0)}) {
    \$icon->set_tooltip(\$menutray_tooltip);
}

\$icon->set_from_icon_name('$CONFIG{menutray_icon}');
\$icon->set_visible(1);
\$icon->signal_connect('button-release-event', \\&show_icon_menu);

local \$SIG{USR1} = \\&show_icon_menu;

load_menu();

sub show_icon_menu {
HEADER

    $generated_menu .= <<"HEADER";
    my (undef, \$event) = \@_;

    if (ref(\$event) and \$event->button == 3) {

        my \$right_click = '${GTK}::Menu'->new;
${\(regenerate_item('$right_click', 'Regenerate', 'gtk-refresh') =~ s/^/        /rmg)}
${\(      quit_item('$right_click', 'Quit',  'application-exit') =~ s/^/        /rmg)}
        \$right_click->show_all;
        ${\(popup_menu('$right_click'))}
        return 1;
    }
HEADER

    $generated_menu .= <<"HEADER";
    ${\(popup_menu('$menu'))}
    return 1;
}

sub load_menu {
HEADER

    my %categories;
    foreach my $file ($desk_obj->get_desktop_files) {

        my $entry = $desk_obj->parse_desktop_file($file) // next;

#<<<
        eval {
            require File::DesktopEntry;
            my $fde = File::DesktopEntry->new($file);
            $entry->{Name}    = encode_utf8($fde->get('Name') // '');
            $entry->{Comment} = encode_utf8($fde->get('Comment') // '') if $CONFIG{tooltips};
        } if $CONFIG{locale_support};
#>>>

        foreach my $cat (@{$entry->{Categories}}) {
            push @{$categories{$cat}}, $entry;
        }
    }

    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}) {
            require Cwd;
            my ($label, $icon) = @{$schema->{menutray}};
            push_app(
                     [
                      {
                       Exec    => join(' ', $CONFIG{editor}, quotemeta(Cwd::abs_path($menu_file))),
                       Name    => "Menu",
                       Icon    => 'gtk-edit',
                       Comment => 'Open the menu file for inspection',
                      },
                      {
                       Exec    => join(' ', $CONFIG{editor}, quotemeta(Cwd::abs_path($schema_file))),
                       Name    => "Schema",
                       Icon    => 'gtk-edit',
                       Comment => 'Open the schema file to customize the menu'
                      },
                      {
                       Exec    => join(' ', $CONFIG{editor}, quotemeta(Cwd::abs_path($config_file))),
                       Name    => "Config",
                       Icon    => 'gtk-edit',
                       Comment => 'Open the configuration file'
                      },
                     ],
                     $label, $icon
                    );
        }
        elsif (exists $schema->{beg}) {
            incr_depth();
            begin_category(@{$schema->{beg}});
        }
        elsif (exists $schema->{end}) {
            $generated_menu .= end_category();
        }
        elsif (exists $schema->{exit}) {
            my ($name, $icon) = @{$schema->{exit}};
            $generated_menu .= quit_item($menu, $name, $icon);
        }
        elsif (exists $schema->{regenerate}) {
            my ($name, $icon) = @{$schema->{regenerate}};
            $generated_menu .= regenerate_item($menu, $name, $icon);
        }
        elsif (exists $schema->{sep}) {
            $generated_menu .= <<"SEPARATOR";
\n    $menu->append('${GTK}::SeparatorMenuItem'->new);
SEPARATOR
        }
        else {
            warn "$0: invalid key '", (keys %{$schema})[0], "' in schema file!\n";
        }
    }

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

    if ($depth != 0) {
        die "$0: unbalanced beg/end submenus! (depth: $depth)\n";
    }

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

dump_configuration() if $update_config;

(-f $menu_file)
  ? exec($^X, $menu_file)
  : do { output_usage(); exit 1 };
