lire 2:2.1.1-2.1 / usr / share / perl5 / Lire / UI / Prefs.pm

package Lire::UI::Prefs;

use strict;

use Curses;
use Curses::UI;
use Lire::Config;
use Lire::Utils qw/ check_object_param /;
use Locale::TextDomain 'lire';

use Carp;

=pod

=head1 NAME

Lire::UI::Prefs - Preferences management

=head1 SYNOPSIS

  use Lire::UI::Prefs;

=head1 DESCRIPTION

XXX FIXME

=cut

sub new {
    my ( $class, $ui, $config ) = @_;

    check_object_param( $ui, 'ui', 'Curses::UI' );
    check_object_param( $config, 'config', 'Lire::Config::ConfigFile' );

    my $self = bless( { '_ui' => $ui, '_cfg_file' => $config },
                      $class );
    $self->_create_prefs_win();

    return $self;
}

sub show {
    my $self = $_[0];

    my $prefs_win = $self->{ '_ui' }->getobj( 'prefs_win' );
    my $section_menu = $prefs_win->getobj( 'section_menu' );
    $section_menu->{'-selected'} = 0;
    $section_menu->run_event( '-onchange' );
    $prefs_win->modalfocus();
    $self->{ '_ui' }->delete( 'prefs_win' );

    return;
}

sub _create_prefs_win {
    my $self = $_[0];

    my $ui = $self->{'_ui'};
    my $prefs_win = $ui->add( 'prefs_win', 'Window',
                              '-title' => __( 'Lire Preferences' ),
                              '-y' => 1, '-border' => 1,
                              '-ipadleft' => 1, '-ipadright' => 1,
                              '-ipadtop' => 1 );
    $prefs_win->userdata( $self );
    $self->_create_section_menu( $prefs_win );

    my $width = $prefs_win->getobj( 'section_menu' )->canvaswidth() + 2;
    $prefs_win->add( 'options_list', 'Listbox',
                     '-values' => [],
                     '-labels' => {},
                     '-ipadleft' => 1, '-ipadright' => 1,
                     '-y' => 1,
                     '-width' => $width,
                     '-height' => ( $prefs_win->canvasheight() - 1 ),
                     '-onchange' => \&_option_change_cb,
                     '-onselchange' => \&_option_selchange_cb,
                     '-border' => 1 );

    $prefs_win->add( 'option_summary', 'Label',
                     '-text' => '', '-bold' => 1,
                     '-width' => ( $prefs_win->canvaswidth() - $width - 3 ),
                     '-x' => $width + 2 );
    $prefs_win->add( 'option_help', 'TextViewer',
                     '-x' => $width + 1, '-y' => 14,
                     '-border' => 0, '-padbottom' => 2,
                     '-wrapping' => 1, '-vscrollbar' => 1,
                     '-ipadleft' => 1, '-ipadright' => 1,
                     '-text' => '' );
    $self->_create_buttons( $prefs_win );

    return;
}

sub _create_section_menu {
    my ( $self, $win ) = @_;

    my @values = ( 'report', 'responder', 'operation',
                   'path', 'docbook', 'programs' );
    my @labels = ( __( 'Reports' ),
                   __( 'Responder Preferences' ),
                   __( 'Operational Preferences' ),
                   __( 'Lire Paths' ),
                   __( 'Docbook Paths' ),
                   __( 'Program Paths' ) );
    my $labels = {};
    for ( my $i = 0; $i < @values; $i++ ) {
        $labels->{$values[$i]} = $labels[$i];
    }
    my $section_menu = $win->add( 'section_menu', 'Popupmenu',
                                  '-selected' => 0,
                                  '-labels' => $labels,
                                  '-values' => \@values,
                                  '-onchange' => \&_section_change_cb );
    return;
}

sub _create_buttons {
    my ( $self, $win ) = @_;

    my $buttons = $win->add( 'buttons', 'Buttonbox',
                             '-buttons' => [ { '-label' => __( '< Cancel >' ),
                                               '-onpress' => \&_cancel_cb },
                                             { '-label' => __( '< OK >' ),
                                               '-onpress' => \&_ok_cb, }  ],
                             '-padleft' => 30,
                             '-y' => -1, '-buttonalignment' => 'right' );

    return;
}

sub _get_var {
    my ( $self, $name ) = @_;

    if ( ! $self->{'_cfg_file'}->is_set( $name ) ) {
        my $clone = Lire::Config->get_var( $name )->clone();
        $self->{'_cfg_file'}->set( $clone );
    }

    return $self->{'_cfg_file'}->get( $name );
}

# callback functions
sub _section_change_cb {
    my $widget = $_[0];

    my $self = $widget->parent()->userdata();
    my $options =
      $self->{'_cfg_file'}->spec()->components_by_section( $widget->get() );
    my $options_list = $widget->parent()->getobj( 'options_list' );
    my $labels = { map { $_ => $_->name() } @$options };

    $options_list->{'-values'} = $options;
    $options_list->{'-labels'} = $labels;
    $options_list->{'-ypos'} = 0;
    $options_list->run_event( '-onselchange' );

    $options_list->draw();

    return;
}

sub _option_selchange_cb {
    my $widget = $_[0];

    $widget->{'-selected'} = $widget->{'-ypos'};
    $widget->run_event( '-onchange' );

    return;
}

sub _option_change_cb {
    my $widget = $_[0];

    $widget->{'-ypos'} = $widget->{'-selected'};
    my $self = $widget->parent()->userdata();
    my $option = $widget->get();
    my $opt_summary = $widget->parent()->getobj( 'option_summary' );
    my $opt_help = $widget->parent()->getobj( 'option_help' );

    $opt_help->cursor_up( undef, $opt_help->{'-yscrpos'} )
      if ( $opt_help->{'-yscrpos'} > 1 );

    if ( !defined $option ) {
        $widget->{'-ypos'} = 0;
        $widget->{'-selected'} = undef;
        $opt_summary->text( '' );
        $opt_help->text( '' );
    } else {
        $widget->parent()->delete( 'option_widget' )
          if $widget->parent()->getobj( 'option_widget' );
        $widget->parent()->add( 'option_widget', 'Lire::UI::Widget',
                                '-x' => $opt_summary->{'-x'},
                                '-y' => $opt_summary->{'-y'} + 2,
                                '-height' => 11,
                                'value' => $self->_get_var( $option->name() ));
        $opt_summary->text( $option->summary() );
        $opt_help->text( $option->text_description()
                         || __( 'No help available.' ) );
        $widget->parent()->intellidraw();
    }

    return;
}

sub _cancel_cb {
    my $buttons = $_[0];

    my $prefs_win = $buttons->parent();
    $prefs_win->loose_focus();
    my $self = $prefs_win->userdata();
    $self->{'_cfg_file'}->revert();

    return;
}

sub _ok_cb {
    my $buttons = $_[0];

    my $prefs_win = $buttons->parent();
    $prefs_win->loose_focus();
    my $self = $prefs_win->userdata();
    $self->{'_cfg_file'}->save();

    return;
}

# keep perl happy
1;

__END__

=pod

=head1 SEE ALSO

Lire::UI(3pm)

=head1 VERSION

$Id: Prefs.pm,v 1.20 2006/07/23 13:16:32 vanbaal Exp $

=head1 AUTHORS

Francis J. Lacoste <flacoste@logreport.org>
Wolfgang Sourdeau <wolfgang@logreport.org>

=head1 COPYRIGHT

Copyright (C) 2004 Stichting LogReport Foundation LogReport@LogReport.org

This file is part of Lire.

Lire 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 2 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 (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html.

=cut