view release on metacpan or  search on metacpan

lib/Config/Model/TermUI.pm  view on Meta::CPAN

#
# This file is part of Config-Model
#
# This software is Copyright (c) 2005-2022 by Dominique Dumont.
#
# This is free software, licensed under:
#
#   The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::TermUI 2.162;

use Carp;
use utf8;      # so literals and identifiers can be in UTF-8
use v5.20;     # to get "unicode_strings" feature
use strict;
use warnings;
use open      qw(:std :utf8);    # undeclared streams in UTF-8
use Encode qw(decode_utf8);

use Term::ReadLine;

use base qw/Config::Model::SimpleUI/;

use feature qw/postderef signatures/;
no warnings qw/experimental::postderef experimental::signatures/;

my $completion_sub = sub ($self, $text, $line, $start) {
    my @choice = $self->{current_node}->get_element_name;
    my @ret = grep { /^$text/ } @choice ;
    return @ret;
};

my $leaf_completion_sub = sub ($self, $text, $line, $start) {
    my @choice = $self->{current_node}->get_element_name( cargo_type => 'leaf' );
    my @ret = grep { /^$text/ } @choice ;
    return @ret;
};

my $fix_completion_sub = sub ($self, $text, $line, $start) {
    my @choice = $self->{current_node}->get_element_name;
    push @choice, '!';
    my @ret = grep { /^$text/ } @choice ;
    return @ret;
};

my $ll_completion_sub = sub ($self, $text, $line, $start) {
    my @choice = $self->{current_node}->get_element_name;
    push @choice, '-nz';
    my @ret = grep { /^$text/ } @choice ;
    return @ret;
};

# BUG: autocompletion does not really work on a hash element with an index
# containing white space (i.e. something like std_id:"abc def",

my $cd_completion_sub = sub ($self, $text, $line, $start) {
    # we know that text begins with 'cd '
    my $cmd = $line;
    $cmd =~ s/cd\s+//;

    # convert usual cd_ism ( '..' '/foo') to grab syntax ( '-' '! foo')
    #$text =~ s(^/)  (! );
    $cmd =~ s/^\.\.$/-/g;
    #$text =~ s(/)   ( )g;

    my $new_item;
    while ( not defined $new_item ) {

        # grab in tolerant mode
        #print "Grabbing $cmd\n";
        eval {
            $new_item = $self->{current_node}->grab(
                step => $cmd, type => 'node', mode => 'strict', autoadd => 0
            );