#! /usr/local/bin/perl

# Use pod2html, pod2text or some such to format this embedded doc:

my $Copyright = '
Copyright © 2001, \'02, Daniel Pfeiffer <occitan@esperanto.org>

kgenmenu4sawfish may be copied only under the terms of either the Artistic
License or the GNU General Public License, which may be found in the sawfish
or the Perl 5 source kit.
';

=head1 NAME

kgenmenu4sawfish - access KDE menu from sawfish (even without running desktop)

=head1 SYNOPSIS

  $ kgenmenu4sawfish --apps-menu

In your resource file F<~/.sawfish/rc> you could add something like:

  (load-file "~/.sawfish/kdemenu")

=head1 USAGE

kgenmenu4sawfishC<[> I<option>C<|>I<directory>C<[>:I<variable>C<]>C<]> ...

If no arguments are given, those given the last time (to at least version 0.6)
are reused.  This allows building up and reusing complex rules.

=over

=item -a, --apps-menu

This is equivalent to an argument of C<.:apps-menu>.

=item -c, --charset=I<string>

This is the destination charset as accepted by C<recode>, e.g. C<latin2>.

=item -d, --delete=I<regexp>

Delete anything matching regexp in any command to be executed by a menu point.

=item -e, --eval=I<Perl-code>

For every command to be executed by a menu point, eval the argument.  This
should modify C<$_>, the current command with all transformations already
performed, but not yet output.

=item -o, --old-args, --old-arguments

Only displays the remembered argument list from the last time.  Useful for
smaller modifications.

=item -s, --source, --show-source

Annotates each menu-item in the resulting file with a comment saying from
which F<.desktop> file it came.

=item -u, --unique

Eliminate any command already identically called by another menu point.

=item -v, --version

=item -?, --help

=back

Other arguments refer to directories relative to F<share/applnk> under each of
F<$KDEHOME>, F<$KDEDIR> and all other F<$KDEDIRS>.  These (e.g. SuSE's
extensive menu which contains applications other than KDE) can be drawn into
separate menu variables.  If a colon and a variable-name is given, the menu is
stored in that variable.  Else the directory-name with a leading C<kde-> and a
trailing C<-menu> is used.

If the variable is C<->, that directory is ignored.  Unlike for real
variables, this may be repeated for several directories.

=head1 DESCRIPTION

Though they don't boast about it, KDE can very well cooperate with other
window-managers.  Of course you have to find matching themes for yourself.
And while KDE goes along with viewports it doesn't seem to have a feature to
manage them.  AMOR works but you have to adjust its height manually.  But
these glitches are minor, and sawfish is mostly far superior to kwin.  You
start it by finding the ksmserver-line in the startup script and adding this
option:

  ksmserver --windowmanager sawfish

Or you start sawfish without KDE and use this menu to still get full access to
KDE-applications.  You can even also include the Gnome menu and get the best
from both worlds.

This utility goes through the desktop files in C<$KDEHOME> (if set),
C<$KDEDIR> and all other C<$KDEDIRS> and extracts all desktop configurations
on how to execute programmes.

The menu label language is selected based on your KDE configuration.  If that
can't be determined, uses C<$LC_MESSAGES> or C<$LANG> where a country variant,
if present, is given precedence over a language-only variant.

For Gnome1 sawfish you must recode Unicode/utf8,to single byte.  You need to
set the destination in C<--charset>.  Those commands which are setup to pass
the localized title, also get that recoded.

The resulting sawfish menu is stored in variable C<kde-menu>, unless you use
the command line option C<--apps-menu> or an argument C<.:I<apps-menu>>.  In
the former case you must include this in your menus yourself.  In the latter
case, sawfish's C<apps-menu> variable gets overwritten, placing the
KDE-applications on your menu automatically.

=head1 BUGS

When upgrading from a pre 0.6 version, display your remembered options with -o
and pass them in explicitly the first time.

There are no icons, because sawfish cannot handle them in its menus.

KDE has very many applications so this menu will normally be big - 27kb
compared to 4kb for sawfish's gnome-menu on SuSE.  And that's with
C<--unique>, else you're at 37kb.  Since sawfish passes menus off to a
dedicated process, there is a very noticeable delay (1 - 2 secs on a Pentium
266) even with menu-process already running.  Probably the sawfish-menu
process should cache menus, but then of course it can't be guaranteed that the
list in sawfish isn't physically modified in the meantime.

It's static, but menus don't change so often.

The gnome menu, if you use it, is not taken into account for --unique.

It's written in Perl, because that was quicker to hack than sawfish lisp.

Given all these drawbacks, future versions should link to or somehow access
code from Kicker directly and thus popup a Qt-menu.

=head1 EXAMPLES

At least SuSE kindly checks for 3D and/or sound before calling quite a few
commands.  The option C<-d'CheckHardware(?: +--(?:3D|sound))+'> eliminates that.

An argument of C<SuSE> (given that distribution) will put their submenu as
top-level into a separate variable C<kde-SuSE-menu>.  Whereas with an argument
of C<SuSE:suse-menu> the lisp variable name C<suse-menu> wil be assigned to.

An argument of C<System/ScreenSavers:-> will completely ignore the KDE
screensaver menu, and its submenus if it had any, in sawfish.

=head1 AUTHOR

Daniel Pfeiffer <occitan@esperanto.org>

=cut

my $VERSION = 0.8;

chdir "$ENV{HOME}/.sawfish"
    or die "Can't cd to ~/.sawfish:\n\t$!\n";

sub arguments() {
    return unless -r 'kdemenu';
    open IN, 'kdemenu';
    my @arguments = split ' ', $1
        if <IN> =~ /^;arguments: (.*)/;
    close IN;
    @arguments;
}

@ARGV = arguments unless @ARGV; # magic variable, can't use ||=
my @ARGVremember = @ARGV;

use Getopt::Long;
Getopt::Long::config qw(bundling no_getopt_compat);

GetOptions

    'a|apps-menu' => sub { $variable{'.'} = 'apps-menu' },

    'c|charset:s' => sub { $charset = $_[1] },

    'd|delete:s' => sub { $delete =  $_[1] },

    'e|eval:s' => sub { $eval =  $_[1] },

    'o|old-args|old-arguments' => sub {
        my @arguments = arguments;
        print STDERR @arguments ? "@arguments\n" : "no arguments remembered\n";
        exit;
    },

    's|source|show-source',

    'u|unique' => sub { $unique = 1 },

    'v|version' => sub {
        print "This is $0 version $VERSION\n$Copyright";
        exit;
    },

    (($Getopt::Long::VERSION >= 2.17) ? 'help|?' : 'help') => sub {
        print "usage: $0\[ option][ directory[:variable]] ...\n", <<\EOF, $Copyright;
  -a, --apps-menu
  -c, --charset=cs
  -d, --delete=regexp
  -o, --old-args, --old-arguments
  -s, --source, --show-source
  -u, --unique
  -v, --version
EOF
        exit;
    },

    '<>' => sub {
        my( $directory, $variable ) = split ':', $_[0];
        $variable ||= "kde-$directory-menu";
        $directory = "./$directory" unless $directory =~ /^\./;
        $variable{$directory} = $variable;
    };

$variable{'.'} ||= 'kde-menu';

$conf = "$ENV{KDEHOME}/share/config/kdeglobals";
if( -r $conf and $lang = `fgrep 'Country=\nLanguage=' $conf` ) {
    @name = ($lang =~ /Language=(.*)/m);
    unshift @name, "$name[0]_$1"
        if $lang =~ /Country=(.*)/m;
    local $" = '|';
    $re = "(?:\\[(?:@name)\\])?";
    $_ = "Name[$_]" foreach @name;
    push @name, 'Name';
} elsif( $lang = $ENV{LC_MESSAGES} || $ENV{LANG} ) {
    $lang =~ /^((..)(...)?)/;
    if( $3 ) {
        @name = ("Name[$1]", "Name[$2]", 'Name');
        $re = "(?:\\[(?:$1|$2)\\])?";
    } else {
        @name = ("Name[$1]", 'Name');
        $re = "(?:\\[$1\\])?";
    }
} else {
    @name = 'Name';
}

use File::Find;

sub gather {
    $File::Find::prune = 1, return 
	if $variable{$File::Find::name} eq '-'
	or /^\.hidden$/;
    return unless /\.desktop$|^(\.directory)$/;
    return if $found{$File::Find::name};
    my $directory = $1;

    open DT, $_;
    my %mem;
    while( <DT> ) {
        next if 1../^\[(?:KDE )?Desktop Entry\]/;
        last if /^\[/;
        next unless /^(Name$re|Exec|Icon|Miniicon)=(.*)/o;
        $mem{$1} = $2;
    }
    close DT;
    next unless $directory or $mem{Exec};
    my $name;
    foreach( @name ) {
        last if $name = $mem{$_};
    }

    my $dirname = substr $File::Find::name, 0, rindex $File::Find::name, '/';

    if( $directory ) {

        $found{$dirname} = $found{$File::Find::name} = "\"$name\"";

        $parentdirname =
            substr $dirname, 0, rindex $dirname, '/';
        push @{$directory{$parentdirname}}, \$dirname
            if $parentdirname;

        $depth{$dirname} = ($dirname =~ tr|/||);

    } else {

        push @{$directory{$dirname}}, $File::Find::name;

        $mem{Miniicon} ||= $mem{Icon};
        for( $mem{Exec} ) {
            s/"/\\"/g;
            s/%[uUf]//g;
            s/%c/$name/;
            s/%i/-icon $mem{Icon}/;
            s/%m/-miniicon $mem{Miniicon}/;
	    s/$delete//o if $delete;
	    eval $eval if $eval;
        }

        $found{$File::Find::name} =
	    "(" .
	    ($opt_s ? " ; $File::Find::name\n " : '') .
	    "\"$name\" (system \"$mem{Exec}&\"))"
		if $unique ? !$added{$mem{Exec}}++ : 1;

    }
}

chdir "$ENV{KDEHOME}/share/applnk" and
    find \&gather, '.';

chdir "$ENV{KDEDIR}/share/applnk" or
    die "can't cd to $KDEDIR/share/applnk:\n\t$!\n";
find \&gather, '.';

foreach( split ':', $ENV{KDEDIRS} ) {
    next if $_ eq $ENV{KDEDIR};
    chdir "$_/share/applnk" and
	find \&gather, '.';
}


foreach( sort { $depth{$b} <=> $depth{$a} } keys %directory ) {
    my $directory = $_;
    my @contents =
        sort { lc $a cmp lc $b }
            grep { $_ = $found{$$_} if ref and $found{$$_} =~ /^\(/ }
                @{$directory{$directory}};
    push @contents,
	sort { lc $a cmp lc $b }
	    grep { $_ = $found{$_} } @{$directory{$directory}};
    next unless @contents;
    my $contents =
        '(' .
        ($variable{$directory} ? '' : "$found{$directory}\n") .
        join( "\n", @contents ) .
        ")\n";
    if( $variable{$directory} ) {
        $result .=
            "(set (defvar $variable{$directory} nil)\n'$contents)\n";
        $found{$directory} = '';
    } else {
        $found{$directory} = $contents;
    }
}

chdir "$ENV{HOME}/.sawfish";


$ENV{DEFAULT_CHARSET} = $charset;

open STDOUT,
    $charset ? '| recode -f utf8 > kdemenu' : '> kdemenu'
    or die "Can't open ~/.sawfish/kdemenu for writing:\n\t$!\n";

$" = ' ';
print ";arguments: @ARGVremember
; Generated by command kgenmenu4sawfish.
$result"