#!/usr/bin/perl
my($app_svnid) = '$HeadURL$ $LastChangedRevision$';   ## no critic (RequireInterpolationOfMetachars)

#  Modules
use strict;
use warnings;
use lib substr(`ade-config ade_share_prefix`,0,-1) . '/include';  ## no critic (ProhibitBacktickOperators)
use ADE;
use Getopt::Long qw(:config no_ignore_case);
use experimental 'smartmatch';

#  Errors
my(%lxadepl_defined_errors) = (
    lxadepl_err_misc         => { fmt => '%s' },
);

#  Options
my ($opt_force, $opt_labelwhat);

#  Other globals

#  The next line is extracted by 'adegmt -l'. After adegmt has been used to get this template the line can be removed.
#  ADEGMT-LIST-HINT: ADE-based perl script implementing lx(1)

sub lxadepl
{
    my($errstack_ref) = @_;
    my($rc);
    my($isrelabelable_flag, $label);

    #  Defaults for options
    $opt_force = 0;
    $opt_labelwhat = 0;

    #  Register errors, options and callbacks
    ADE::register_error_types(\%lxadepl_defined_errors);
    if (($rc=ADE::register_options($errstack_ref, 'wibF', 'window,icon,both,force', 'main::handle_option_%s')) != $ADE::OK) {
        return($rc);
    }
    if (($rc=ADE::set_callbacks($errstack_ref, \&lxadepl_usage_help, \&lxadepl_version, \&lxadepl_paths)) != $ADE::OK) {
        return($rc);
    }

    #  Process options
    if (($rc=ADE::process_options($errstack_ref)) != $ADE::OK) {
        return($rc);
    }

    #  Process arguments
    ADE::show_bad_usage($errstack_ref) if (not defined $ARGV[0] or defined $ARGV[1]);
    $label = $ARGV[0];

    #  Sanity checks and derivations
    #  Note: we don't check is_relabelable_term()'s return code; also we use comma operator to stuff call to is_relabelable_term() inside expression.
    if ((not $opt_force) and (is_relabelable_term($errstack_ref, $ENV{'TERM'}, \$isrelabelable_flag), not $isrelabelable_flag)) {
        ADE::error($errstack_ref, 'lxadepl_err_misc', 'the title of this sort of terminal cannot be changed by this program (is TERM set correctly?)');
        return($ADE::FAIL);
    }

    #  Guts
    print "]$opt_labelwhat;$label";
    return($ADE::OK);
}

#  Option handlers
sub handle_option_w
{
    my($errstack_ref) = @_;

    $opt_labelwhat = 2;

    return $ADE::OK;
}

sub handle_option_window ## no critic (RequireArgUnpacking)
{
    return(handle_option_w(@_));
}

sub handle_option_i
{
    my($errstack_ref) = @_;

    $opt_labelwhat = 1;
    return $ADE::OK;
}

sub handle_option_icon ## no critic (RequireArgUnpacking)
{
    return(handle_option_i(@_));
}

sub handle_option_b
{
    my($errstack_ref) = @_;

    $opt_labelwhat = 0;
    return $ADE::OK;
}

sub handle_option_both ## no critic (RequireArgUnpacking)
{
    return(handle_option_b(@_));
}

sub handle_option_F ## no critic (Capitalization)
{
    my($errstack_ref) = @_;

    $opt_force = 1;
    return $ADE::OK;
}

sub handle_option_force ## no critic (RequireArgUnpacking)
{
    return(handle_option_F(@_));
}

#  Callbacks
sub lxadepl_usage_help
{
    my($errstack_ref, $usage_text_short_ref, $usage_text_long_ref) = @_;

    ${$usage_text_short_ref} = "<text>\n";
    ${$usage_text_long_ref}  = "         -w        | --window                label the window only\n" .
                               "         -i        | --icon                  label the icon only\n" .
                               "         -b        | --both                  label both (default)\n" .
                               "         -F        | --force                 ignore 'TERM' and force labelling\n";
    return($ADE::OK);
}

sub lxadepl_version
{
    my($errstack_ref, $version_text_ref) = @_;

    return(ADE::extract_version($errstack_ref, $app_svnid, $version_text_ref));
}

sub lxadepl_paths
{
    my($errstack_ref, $pathlist_text_ref) = @_;
    my($rc);

    ${$pathlist_text_ref} = undef;
    return($ADE::OK);
}

#  Other functions
sub is_relabelable_term
{
    my($errstack_ref, $term, $isrelabelable_flag_ref) = @_;
    my($rc);

    if (not defined $term) {
        ${$isrelabelable_flag_ref} = 0;
    } elsif ($term ~~ [ qw/rxvt xterm xterm-debian cygwin/ ]) {
        ${$isrelabelable_flag_ref} = 1;
    } elsif ($term =~ /xterm/) {
        ADE::warning($errstack_ref, 'lxadepl_err_misc', 'guessing this is some sort of xterm');
        ${$isrelabelable_flag_ref} = 1;
    } elsif ($term eq 'vt100' and $ENV{'TERMCAP'} =~ /XSC\|/) {
        ${$isrelabelable_flag_ref} = 1;
    } else {
        ${$isrelabelable_flag_ref} = 0;
    }
    return($ADE::OK);
}

#  Entry point
ADE::main(\&lxadepl);