triz桌面计算机,obmenu-generator

#!/usr/bin/perl

# Copyright (C) 2010-2020 Daniel "Trizen" Șuteu .

#

# 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 .

# Openbox Menu Generator

# A fast menu generator for the Openbox Window Manager, with support for icons.

# Edited on 07 December 2014 by Bob Currey

# added cmd line option -t "Menu Label Text" with default of "Applications"

# Name: obmenu-generator

# License: GPLv3

# Created: 25 March 2011

# Latest edit: 03 December 2020

# https://github.com/trizen/obmenu-generator

use 5.014;

#use strict;

#use warnings;

use Linux::DesktopFiles;

my $pkgname = 'obmenu-generator';

my $version = '0.89';

our ($CONFIG, $SCHEMA);

my $output_h = \*STDOUT;

my ($pipe, $static, $with_icons, $reload_config, $db_clean, $update_config, $reconf_openbox);

my $home_dir =

$ENV{HOME}

|| $ENV{LOGDIR}

|| (getpwuid($

|| `echo -n ~`;

my $xdg_config_home = "$home_dir/.config";

my $menu_id = "root-menu";

my $menu_label_text = "Applications";

my $config_dir = "$xdg_config_home/$pkgname";

my $schema_file = "$config_dir/schema.pl";

my $config_file = "$config_dir/config.pl";

my $openbox_conf = "$xdg_config_home/openbox";

my $menufile = "$openbox_conf/menu.xml";

my $cache_db = "$config_dir/cache.db";

my $icons_dir = "$config_dir/icons";

sub usage {

print <

usage: $0 [options]

menu:

-p : generate a dynamic menu (pipe)

-s : generate a static menu

-i : include icons

-m : menu id (default: 'root-menu')

-t : menu label text (default: 'Applications')

misc:

-u : update the config file

-d : regenerate the cache file

-c : reconfigure openbox automatically

-R : reconfigure openbox and exit

-S : absolute path to the schema.pl file

-C : absolute path to the config.pl file

-o : absolute path to the menu.xml file

info:

-h : print this message and exit

-v : print version and exit

examples:

$0 -p -i # dynamic menu with icons

$0 -s -c # static menu without icons

=> Config file: $config_file

=> Schema file: $schema_file

HELP

exit 0;

}

my $config_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.: name.desktop)

Example: qr/^(?:gimp|xterm)\\b/, # skips 'gimp' and 'xterm'

| skip_entry : Skip a desktop file if the value from a given key matches the regex.

Example: [

{key => 'Name', re => qr/(?:about|terminal)/i},

{key => 'Exec', re => qr/^xterm/},

{key => 'OnlyShowIn', re => qr/XFCE/},

],

| substitutions : Substitute, by using a regex, in the values from the desktop files.

Example: [

{key => 'Exec', re => qr/xterm/, value => 'tilix', global => 1},

],

|| ICON SETTINGS

| use_gtk3 : Use the Gtk3 library for resolving the icon paths. (default: 0)

| gtk_rc_filename : Absolute path to the GTK configuration file.

| missing_icon : Use this icon for missing icons (default: gtk-missing-image)

| icon_size : Preferred size for icons. (default: 48)

| generic_fallback : Try to shorten icon name at '-' characters before looking at inherited themes. (default: 0)

| force_icon_size : Always get the icon scaled to the requested size. (default: 0)

|| 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/*"),

],

|| NOTES

| Regular expressions:

* use qr/.../ instead of '...'

* use qr/.../i for case insensitive mode

HELP

sub remove_database {

my ($db) = @_;

foreach my $file ($db, "$db.dir", "$db.pag") {

unlink($file) if (-e $file);

}

}

if (@ARGV) {

while (defined(my $arg = shift @ARGV)) {

if ($arg eq '-i') {

$with_icons = 1;

}

elsif ($arg eq '-p') {

$pipe = 1;

}

elsif ($arg eq '-s') {

$static = 1;

}

elsif ($arg eq '-d') {

$db_clean = 1;

remove_database($cache_db);

}

elsif ($arg eq '-u') {

$update_config = 1;

}

elsif ($arg eq '-v') {

print "$pkgname $version\n";

exit 0;

}

elsif ($arg eq '-c') {

$reconf_openbox = 1;

}

elsif ($arg eq '-R') {

exec 'openbox', '--reconfigure';

}

elsif ($arg eq '-S') {

$schema_file = shift(@ARGV) // die "$0: option '-S' requires an argument!\n";

}

elsif ($arg eq '-C') {

$reload_config = 1;

$config_file = shift(@ARGV) // die "$0: options '-C' requires an argument!\n";

}

elsif ($arg eq '-o') {

$menufile = shift(@ARGV) // die "$0: option '-o' requires an argument!\n";

}

elsif ($arg eq '-m') {

$menu_id = shift(@ARGV) // die "$0: option '-m' requires an argument!\n";

}

elsif ($arg eq '-t') {

$menu_label_text = shift(@ARGV) // die "$0: option '-t' requires an argument!\n";

}

elsif ($arg eq '-h') {

usage();

}

else {

die "$0: option `$arg' is invalid!\n";

}

}

}

if (not -d $config_dir) {

require File::Path;

File::Path::make_path($config_dir)

or die "$0: can't create configuration directory `$config_dir': $!\n";

}

if ($with_icons and not -d $icons_dir) {

remove_database($cache_db);

require File::Path;

File::Path::make_path($icons_dir)

or warn "$0: can't create icon path `$icons_dir': $!\n";

}

my $config_documentation = <

#!/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,

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",

],

#>>>

},

terminal => 'xterm',

editor => 'geany',

missing_icon => 'gtk-missing-image',

gtk_rc_filename => "$home_dir/.gtkrc-2.0",

icon_size => 48,

force_icon_size => 0,

generic_fallback => 0,

locale_support => 1,

use_gtk3 => 0,

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) {

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 warn "$0: can't copy file `$etc_schema_file' to `$schema_file': $!\n";

}

else {

die "$0: schema file `$schema_file' does not exists!\n";

}

}

# Load the configuration files

require $schema_file;

require $config_file if $reload_config;

# Remove invalid user-defined keys

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

@CONFIG{@valid_keys} = @{$CONFIG}{@valid_keys};

if ($CONFIG{VERSION} != $version) {

$CONFIG{VERSION} = $version;

dump_configuration();

}

my $desk_obj = Linux::DesktopFiles->new(

%{$CONFIG{'Linux::DesktopFiles'}},

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

keys_to_keep => ['Name', 'Exec',

($with_icons ? 'Icon' : ()),

(

ref($CONFIG{'Linux::DesktopFiles'}{skip_entry}) eq 'ARRAY'

? (map { $_->{key} } @{$CONFIG{'Linux::DesktopFiles'}{skip_entry}})

: ()

),

],

terminal => $CONFIG{terminal},

case_insensitive_cats => 1,

);

if ($pipe or $static) {

my $menu_backup = $menufile . '.bak';

if (not -e $menu_backup and -e $menufile) {

require File::Copy;

File::Copy::copy($menufile, $menu_backup);

}

if ($static) {

open $output_h, '>', $menufile

or die "Can't open file '${menufile}' for write: $!";

}

elsif ($pipe) {

if (not -d $openbox_conf) {

require File::Path;

File::Path::make_path($openbox_conf)

or die "Can't create directory '${openbox_conf}': $!";

}

require Cwd;

my $exec_name = Cwd::abs_path($0);

if (not -x $exec_name) {

$exec_name = "$^X $exec_name";

}

$with_icons && ($exec_name .= q{ -i});

open my $fh, '>', $menufile

or die "Can't open file '${menufile}' for write: $!";

print $fh <

xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"

xsi:schemaLocation="http://openbox.org/">

PIPE_MENU_HEADER

close $fh;

print STDERR <

:: A dynamic menu has been successfully generated!

EOT

exec 'openbox', '--reconfigure';

}

}

my $generated_menu = $static

? <

xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"

xsi:schemaLocation="http://openbox.org/">

STATIC_MENU_HEADER

: "\n";

sub get_icon_path {

my ($name) = @_;

state $gtk = do {

require Digest::MD5;

$CONFIG{use_gtk3}

? do {

eval "use Gtk3";

'Gtk3'->init;

'Gtk3';

}

: do {

require Gtk2;

'Gtk2'->init;

'Gtk2';

};

};

state $theme =

($gtk eq 'Gtk2')

? Gtk2::IconTheme->get_default

: Gtk3::IconTheme::get_default();

#<<<

state $flags = "${gtk}::IconLookupFlags"->new(

[

($CONFIG{force_icon_size} ? 'force-size' : ()),

($CONFIG{generic_fallback} ? 'generic-fallback' : ()),

]

);

#>>>

foreach my $icon_name ($name, $CONFIG{missing_icon}) {

#<<<

my $pixbuf = eval {

(substr($icon_name, 0, 1) eq '/')

? (substr($icon_name, -4) eq '.xpm')

? "${gtk}::Gdk::Pixbuf"->new_from_file($icon_name)->scale_simple($CONFIG{icon_size}, $CONFIG{icon_size}, 'hyper')

: "${gtk}::Gdk::Pixbuf"->new_from_file_at_size($icon_name, $CONFIG{icon_size}, $CONFIG{icon_size})

: $theme->load_icon($icon_name, $CONFIG{icon_size}, $flags);

};

#>>>

if (defined($pixbuf)) {

my $md5 = Digest::MD5::md5_hex($pixbuf->get_pixels);

my $path = "$icons_dir/$md5.png";

$pixbuf->save($path, 'png') if not -e $path;

return $path;

}

}

return '';

}

# Regenerate the cache db if the config or schema file has been modified

if (!$db_clean and ((-M $config_file) < (-M $cache_db) or (-M _) > (-M $schema_file))) {

print STDERR ":: Regenerating the cache DB...\n";

remove_database($cache_db);

$db_clean = 1;

}

eval { require GDBM_File };

dbmopen(my %cache_db, $cache_db, 0777)

or die "Can't create/access database <>: $!";

# Regenerate the icon db if the GTKRC file has been modified

if ($with_icons) {

my $gtkrc_mtime = (stat $CONFIG{gtk_rc_filename})[9];

if ($db_clean) {

$cache_db{__GTKRC_MTIME__} = $gtkrc_mtime;

}

else {

my $old_mtime = $cache_db{__GTKRC_MTIME__} // -1;

if ($old_mtime != $gtkrc_mtime) {

print STDERR ":: Regenerating the cache DB...\n";

dbmclose(%cache_db);

remove_database($cache_db);

dbmopen(%cache_db, $cache_db, 0777)

or die "Can't create database <>: $!";

$cache_db{__GTKRC_MTIME__} = $gtkrc_mtime;

}

}

}

{

my %fast_cache;

sub check_icon {

$fast_cache{$_[0] // return undef} //= ($cache_db{$_[0]} //= get_icon_path($_[0]));

}

}

sub begin_category {

if ($with_icons and (my $icon_path = check_icon($_[1]))) {

<

MENU_WITH_ICON

}

else {

<

MENU

}

}

my %categories;

foreach my $file ($desk_obj->get_desktop_files) {

my %info = split("\0\1\0", $cache_db{$file} // '', -1);

next if exists $info{__IGNORE__};

my $mtime = (stat $file)[9];

my $cache_ok = (%info and $info{__MTIME__} == $mtime);

if ($with_icons and $cache_ok and not exists $info{Icon}) {

$cache_ok = 0;

}

if (not $cache_ok) {

my $entry = $desk_obj->parse_desktop_file($file) // do {

$cache_db{$file} = join("\0\1\0", __IGNORE__ => 1);

next;

};

#<<<

%info = (

Name => $entry->{Name},

Exec => $entry->{Exec},

(

$with_icons

? (Icon => check_icon($entry->{Icon}))

: ()

),

__CATEGORIES__ => join(';', @{$entry->{Categories}}),

__MTIME__ => $mtime,

);

#>>>

eval {

state $x = do {

require Encode;

require File::DesktopEntry;

};

$info{Name} = Encode::encode_utf8(File::DesktopEntry->new($file)->get('Name') // '');

} if $CONFIG{locale_support};

state $entities = {

'&' => '&',

'"' => '"',

'_' => '__',

' '<',

'>' => '>',

};

# Encode XML entities (if any)

$info{Name} =~ tr/"&_<>//

&& $info{Name} =~ s/([&"_<>])/$entities->{$1}/g;

$cache_db{$file} = join("\0\1\0", %info);

}

foreach my $category (split(/;/, $info{__CATEGORIES__})) {

push @{$categories{$category}}, \%info;

}

}

foreach my $schema (@$SCHEMA) {

if (exists $schema->{cat}) {

exists($categories{my $category = lc($schema->{cat}[0]) =~ tr/_a-z0-9/_/cr}) || next;

$generated_menu .= begin_category($schema->{cat}[1], ($with_icons ? $schema->{cat}[2] : ())) . join(

q{},

(

map $_->[1],

sort { $a->[0] cmp $b->[0] }

map [lc($_) => $_],

map {

($with_icons and $_->{Icon})

? <

{Exec}]]>

ITEM_WITH_ICON

: <

{Exec}]]>

ITEM

} @{$categories{$category}}

)

)

. qq[

\n];

}

elsif (exists $schema->{item}) {

my ($command, $label, $icon) = @{$schema->{item}};

if ($with_icons and (my $icon_path = check_icon($icon))) {

$generated_menu .= <

ITEM_WITH_ICON

}

else {

$generated_menu .= <

ITEM

}

}

elsif (exists $schema->{sep}) {

$generated_menu .=

defined($schema->{sep})

? qq[ \n]

: qq[ \n];

}

elsif (exists $schema->{beg}) {

$generated_menu .= begin_category(@{$schema->{beg}});

}

elsif (exists $schema->{begin_cat}) {

$generated_menu .= begin_category(@{$schema->{begin_cat}});

}

elsif (exists $schema->{end}) {

$generated_menu .= qq[

\n];

}

elsif (exists $schema->{end_cat}) {

$generated_menu .= qq[ \n];

}

elsif (exists $schema->{exit}) {

my ($label, $icon) = @{$schema->{exit}};

if ($with_icons and (my $icon_path = check_icon($icon))) {

$generated_menu .= <

EXIT_WITH_ICON

}

else {

$generated_menu .= <

EXIT

}

}

elsif (exists $schema->{raw}) {

$generated_menu .= qq[ $schema->{raw}\n];

}

elsif (exists $schema->{file}) {

sysopen(my $fh, $schema->{file}, 0) or die "Can't open file <{file}>>: $!";

sysread($fh, $generated_menu, -s $schema->{file}, length($generated_menu));

}

elsif (exists $schema->{pipe}) {

my ($command, $label, $icon) = @{$schema->{pipe}};

if ($with_icons and (my $icon_path = check_icon($icon))) {

$generated_menu .= <

PIPE_WITH_ICON

}

else {

$generated_menu .= <

PIPE

}

}

elsif (exists $schema->{obgenmenu}) {

my ($name, $icon) = ref($schema->{obgenmenu}) eq 'ARRAY' ? @{$schema->{obgenmenu}} : $schema->{obgenmenu};

if ($with_icons and (my $icon_path = check_icon($icon))) {

$generated_menu .= <

MENU_WITH_ICON

}

else {

$generated_menu .= <

MENU

}

$generated_menu .= ($with_icons ? <

ITEMS_WITH_ICONS

ITEMS

}

else {

warn "$0: invalid key '", (keys %{$schema})[0], "' in schema file!\n";

}

}

print $output_h $generated_menu, $static

? qq[ \n\n]

: qq[\n];

dump_configuration() if $update_config;

if ($static) {

print STDERR <

:: A static menu has been successfully generated!

EOT

if ($reconf_openbox) {

exec 'openbox', '--reconfigure';

}

}