view release on metacpan or  search on metacpan

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

# $Id: Completion.pm,v 1.20 2003/09/10 13:36:26 pajas Exp $

package XML::XSH::Completion;

use XML::XSH::CompletionList;
use XML::XSH::Functions qw();
use strict;

our @PATH_HASH;
our $M=qr/(?:^|[;}]|\s+{)\s*/;
our $match_sv=qr/\$([a-zA-Z0-9_]*)$/; # scalar variable completion
our $match_nv=qr/\%([a-zA-Z0-9_]*)$/; # node-list variable completion
our $match_command=qr/${M}[^=\s]*$/; # command completion
our $match_func=qr/${M}(?:call|undef|undefine)\s+(\S*)$/; # function name completion
our $match_nodetype=qr/${M}x?(?:insert|add)\s+(\S*)$/; # node-type completion
our $match_doc=qr/${M}(?:close|doc[-_]info|dtd|enc)\s+(\S*)$|${M}clone\s+[a-zA-Z0-9_]*\s*=\s*[a-zA-Z0-9_]*$|${M}create\s+[a-zA-Z0-9_]*/; # docid completion
our $match_clone_doc=qr/${M}clone\s+[a-zA-Z0-9_]*$/;
our $match_help=qr/${M}(?:\?|help)\s+(\S*)$/; # help topic completion
our $match_open_flag1=qr/${M}open(?:\s+|([-_]))([A-Z]*)$/;
our $match_open_flag2=qr/${M}(?:open\s+|(open[-_]))(html|xml|docbook|HTML|XML|DOCBOOK)(?:\s+[A-Z]*|([-_])[A-Za-z]*)$/;
our $match_open_doc=qr/${M}(open)(?:\s+|_|-)(?:(?:html|xml|docbook|HTML|XML|DOCBOOK)(?:\s+|_|-))?(?:(?:file|pipe|string|FILE|PIPE|STRING)\s+)?([a-zA-Z0-9_]*)$/;
our $match_open_filename=qr/${M}(?:open(?:\s+|_|-)(?:(?:html|xml|docbook|HTML|XML|DOCBOOK)(?:\s+|_|-))?(?:(?:file|FILE)\s+)?)?[a-zA-Z0-9_]+\s*=\s*(\S*)$/;

our $match_save_flag1=qr/${M}save(?:\s+|([-_]))([A-Z]*)$/;
our $match_save_flag2=qr/${M}(?:save\s+|(save[-_]))(html|xml|xinclude|HTML|XML|XINCLUDE|XInclude)(?:\s+[A-Z]*|([-_])[A-Za-z]*)$/;
our $match_save_doc=qr/${M}(save)(?:\s+|_|-)(?:(?:html|xml|xinclude|HTML|XML|XInclude|XINCLUDE)(?:\s+|_|-))?(?:(?:file|pipe|string|FILE|PIPE|STRING)\s+)?([a-zA-Z0-9_]*)$/;
our $match_save_filename=qr/${M}save(?:\s+|_|-)(?:(?:html|xml|xinclude|HTML|XML|XInclude|XINCLUDE)(?:\s+|_|-))?(?:(?:file|FILE)\s+)?[a-zA-Z0-9_]+\s+(\S*)$/;
our $match_filename=qr/${M}(?:\.|include)\s+(\S*)$/;
our $match_dir=qr/${M}(?:lcd)\s+(\S*)$/;
our $match_path_filename=qr/${M}(?:system\s|exec\s|\!)\s*\S*$|\s\|\s*\S*$/;
our $match_no_xpath=join '|',@XML::XSH::CompletionList::XSH_NOXPATH_COMMANDS;
our $match_no=qr/${M}(?:${match_no_xpath}|create\s+[a-zA-Z0-9_]*\s)\s*$/;

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

our @nodetypes = qw(element attribute attributes text cdata pi comment chunk entity_reference);
our @openflags1 = qw(HTML XML DOCBOOK);
our @openflags2 = qw(FILE PIPE STRING);
our @saveflags1 = qw(HTML XML XINCLUDE);
our @saveflags2 = qw(FILE PIPE STRING);

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') {
    return eval { map { s:\@$::; $_ } readline::rl_filename_list($word); };
  } else {
    return eval { map { s:\@$::; $_ } Term::ReadLine::Gnu::XS::rl_filename_list($word) };
  }
}

sub rehash_path_hash {
  my %result;
  my $dh;
  my $pdelim= $^O eq 'MSWin32' ? '\\' : '/';
  my $delim=($^O eq 'MSWin32' ? ';' : ':');
  my @path=grep /\S/,split($delim,$ENV{PATH});
  foreach my $dir (@path) {
    local *DIR;
    if (opendir DIR, $dir) {