view release on metacpan or  search on metacpan

lib/XML/XSH2/Completion.pm  view on Meta::CPAN

# $Id: Completion.pm,v 2.7 2007-05-06 19:32:12 pajas Exp $

package XML::XSH2::Completion;

use XML::XSH2::CompletionList;
use XML::XSH2::Functions qw();
use vars qw($VERSION);
use strict;

  $VERSION='2.2.10'; # VERSION TEMPLATE

our @PATH_HASH;
our $O=qr/:[[:alnum:]]|--[-_[:alnum:]]+/; # option
our $F=qr/(?:\s$O)*/o;                   # options
our $M=qr/(?:^|[;}]|\s+\&?{|:\s*[-+*\/x.\%]?=)\s*/o;         # possible command-start
our $match_sv=qr/\$([a-zA-Z0-9_]*)$/o; # scalar variable completion
our $match_command=qr/${M}[^\!=\s]*$/o; # command completion
our $match_option=qr/\s(\:[[:alnum:]]?|--[-_[:alnum:]]*)$/o; # option completion
our $match_func=qr/$M(?:call|undef|undefine)\s+(\S*)$/o; # function name completion
our $match_nodetype=qr/${M}x?(?:insert|add)\s+(\S*)$/o; # node-type completion
our $match_help=qr/$M(?:\?|help)\s+(\S*)$/o; # help topic completion
our $match_filename=qr/$M(?:\.|include|open|save)$F\s+(\S*)$|^\s*!\s*\S+\s+/o;
our $match_dir=qr/$M(?:lcd)\s+(\S*)$/o;
our $match_path_filename=qr/$M(?:system\s|exec\s)\s*\S*$|^\s*\!\s*\S*$|\s\|\s*\S*$/o;

our $NAMECHAR = '[-_.[:alnum:]]';
our $NNAMECHAR = '[-:_.[:alnum:]]';
our $NAME = "$NAMECHAR*$NNAMECHAR*[_.[:alpha:]]";

our $WILDCARD = '\*(?!\*|$NAME|\)|\]|\.)';
our $OPER = qr/(?:[,=<>\+\|]|-(?!$NAME)|(?:vid|dom|dna|ro)(?=\s*\]|\s*\)|\s*[0-9]+(?!$NNAMECHAR)|\s+{$NAMECHAR}|\s+\*))/;


# PATH-completion: system, !, exec, |, 

our @nodetypes = qw(element attribute attributes text cdata pi comment chunk entity_reference);

sub complete_option {
  my ($l)=@_;
  if ($l=~/\s--encoding\s+$|\s:e\s+$/) {
  }
  if ($l=~/$M(\.|[a-zA-Z_][-a-zA-Z0-9_]*)$F\s+(:([[:alnum:]]?)|--([-_[:alnum:]]*))$/) {
    my ($cmd,$o,$p)=($1,$2,$3||$4);
    my $c = $XML::XSH2::Functions::COMMANDS{$cmd};
    $c = $XML::XSH2::Functions::COMMANDS{$c} if (defined($c) and !ref($c));
    if (defined($c) and defined($c->[3])) {
      if ($o =~ /^:/) {
	return map { ":".$_ } grep { length == 1 and /^\Q$p\E/ } keys %{$c->[3]};
      } else {
	return map { "--".$_ } grep { length > 1 and /^\Q$p\E/ } keys %{$c->[3]};
      }
    }
  }
  return ();
}

sub perl_complete {
  my($word,$line,$pos) = @_;
  my $endpos=$pos+length($word);
  cpl('perl',$word,$line,$pos,$endpos);
}

sub gnu_complete {
  my($text, $line, $start, $endpos) = @_;
  &main::_term()->Attribs->{completion_append_character} = ' ';
  my @result=cpl('gnu',$text,$line,$start,$endpos);
  # find longest common match. Can anybody show me how to persuade
  # T::R::Gnu to do this automatically? Seems expensive.
  return () unless @result;
  my($newtext) = $text;
  for (my $i = length($text)+1;;$i++) {
    last unless length($result[0]) && length($result[0]) >= $i;
    my $try = substr($result[0],0,$i);
    my @tries = grep {substr($_,0,$i) eq $try} @result;
    # warn "try[$try]tries[@tries]";
    if (@tries == @result) {
      $newtext = $try;
        } else {
	  last;
        }
  }
  ($newtext,@result);
}

sub complete_set_term_char {
  my ($type,$char)=@_;
  if ($type eq 'perl') {
    $readline::rl_completer_terminator_character = $char;
  } else {
    &main::_term()->Attribs->{completion_append_character} = $char;
  }
}

sub complete_filename {
  my ($type,$word)=@_;
  if ($type eq 'perl') {