[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Psh / PCompletion.pm

#
#	$Id: PCompletion.pm,v 1.20 2003/01/16 19:21:17 gregor Exp $
#
#	Copyright (c) 2000-2003 Hiroo Hayashi. All Rights Reserved.
#
#	This program is free software; you can redistribute it and/or
#	modify it under the same terms as Perl itself.

package Psh::PCompletion;

use strict;
use vars qw(%COMPSPEC %ACTION @ISA @EXPORT_OK);
require Exporter;
require Psh::Completion;
require Psh::Parser;

$Psh::PCompletion::LOADED=1; # tell other packages which optionally want to call us that we're here now

@ISA = qw(Exporter);
@EXPORT_OK = qw(compgen);

# for COMPSPEC actions
# borrowed from bash-2.04
sub CA_ALIAS		{ 1<<0; }
sub CA_ARRAYVAR		{ 1<<1; }
sub CA_BINDING		{ 1<<2; }
sub CA_BUILTIN		{ 1<<3; }
sub CA_COMMAND		{ 1<<4; }
sub CA_DIRECTORY	{ 1<<5; }
sub CA_DISABLED		{ 1<<6; }
sub CA_ENABLED		{ 1<<7; }
sub CA_EXPORT		{ 1<<8; }
sub CA_FILE		{ 1<<9; }
sub CA_FUNCTION		{ 1<<10; }
sub CA_HELPTOPIC	{ 1<<11; }
sub CA_HOSTNAME		{ 1<<12; }
sub CA_JOB		{ 1<<13; }
sub CA_KEYWORD		{ 1<<14; }
sub CA_RUNNING		{ 1<<15; }
sub CA_SETOPT		{ 1<<16; }
sub CA_SHOPT		{ 1<<17; }
sub CA_SIGNAL		{ 1<<18; }
sub CA_STOPPED		{ 1<<19; }
sub CA_USER		{ 1<<20; }
sub CA_VARIABLE		{ 1<<21; }
# psh original
sub CA_HASH		{ 1<<22; }

# pursing argments
BEGIN {
    %ACTION
	= (alias	=> CA_ALIAS,
	   arrayvar	=> CA_ARRAYVAR,	# Perl array variable
	   binding	=> CA_BINDING,
	   builtin	=> CA_BUILTIN,
	   command	=> CA_COMMAND,
	   directory	=> CA_DIRECTORY,
	   disabled	=> CA_DISABLED,	# not implemented yet
	   enabled	=> CA_ENABLED,	# not implemented yet
	   export	=> CA_EXPORT,
	   file		=> CA_FILE,
	   function	=> CA_FUNCTION,	# Perl function
	   helptopic	=> CA_HELPTOPIC,
	   hostname	=> CA_HOSTNAME,
	   job		=> CA_JOB,
	   keyword	=> CA_KEYWORD,
	   running	=> CA_RUNNING,
	   setopt	=> CA_SETOPT,	# not implemented yet
	   shopt	=> CA_SHOPT,	# not implemented yet
	   signal	=> CA_SIGNAL,
	   stopped	=> CA_STOPPED,
	   user		=> CA_USER,
	   variable	=> CA_VARIABLE,	# Perl variable
	   hashvar	=> CA_HASH,	# Perl hash variable
	  );
}

my($__line, $__start, $__cmd);

# global variables for compgen()
#use vars qw($__line $__start $__cmd);

# convert from bash (and ksh?) extglob to Perl regular expression
sub glob2regexp {
    local ($_) = @_;

    # ?(...), *(...), +(...) -> ()?, ()*, ()?
    s/([^\\])([?*+])\(([^)]*)\)/$1($3)$2/g; 
    s/^([?*+])\(([^)]*)\)/($2)$1/g; 

    # @(...) -> (...)
    s/([^\\])@\(([^)]*)\)/$1($2)/g;
    s/^@\(([^)]*)\)/($1)/g;

    # `!(...)' is not supported yet.

    # '.' -> '\.'
    s/([^\\])\./$1\\./g;
    s/^\./\\./g;

    # '*' -> '.*'
    s/([^\\)])\*/$1.*/g;
    s/^\*/.*/g;

    # '$' -> '\$'
    s/\$/\\\$/g;

    return '^' . $_ . '$';
}

sub pcomp_list {
    my ($cs, $text, $line, $start, $cmd) = @_;
    my @l;

	return () unless $line;
    my ($pretext) = substr($line, 0, $start) =~ /(\S*)$/;

    # actions
    if ($cs->{action} & CA_ALIAS and !$pretext) {
		if (Psh::Strategy::active('built_in')) {
			push(@l, grep { /^\Q$text/ } Psh::Support::Alias::get_alias_commands());
		}
    }
    if ($cs->{action} & CA_BINDING and !$pretext) {
	# only Term::ReadLine::Gnu 1.09 and later support funmap_names()
	# use `eval' for other versions
		eval { push(@l, grep { /^\Q$text/ } $Psh::term->funmap_names) };
		Psh::Util::print_debug_class('e',"Error: $@") if $@;
    }
    if ($cs->{action} & CA_BUILTIN  || $cs->{action} & CA_HELPTOPIC) {
		if (Psh::Strategy::active('built_in')) {
			push(@l, grep { /^\Q$text/ } Psh::Support::Builtins::get_builtin_commands());
		}
    }
    if ($cs->{action} & CA_COMMAND and !$pretext) {
		push(@l, Psh::Completion::cmpl_executable($text));
	}
    if ($cs->{action} & CA_DIRECTORY) {
		push(@l, Psh::Completion::cmpl_directories($pretext . $text));
	}
    if ($cs->{action} & CA_EXPORT and !$pretext) {
		push(@l, grep { /^\Q$text/ } keys %ENV);
    }
    if ($cs->{action} & CA_FILE) {
		my @f = Psh::Completion::cmpl_filenames($pretext . $text);
		if (defined $cs->{ffilterpat}) {
			my $pat = $cs->{ffilterpat};
			if ($pat =~ /^!/) {
				$pat = glob2regexp(substr($pat, 1));
				@f = grep(/$pat/, @f);
			} else {
				$pat = glob2regexp($pat);
				@f = grep(! /$pat/, @f);
			}
		}
		push(@l, @f);
		push(@l, Psh::Completion::cmpl_directories($pretext . $text));
	}
    if ($cs->{action} & CA_HOSTNAME and !$pretext) {
		push(@l, grep { /^\Q$text/ } Psh::Completion::bookmarks());
    }
    if ($cs->{action} & CA_KEYWORD and !$pretext) {
		push(@l, grep { /^\Q$text/ } @Psh::Completion::keyword);
    }
    if ($cs->{action} & CA_SIGNAL and !$pretext) {
		push(@l, grep { /^\Q$text/ } grep(!/^__/, keys %SIG));
    }
    if ($cs->{action} & CA_USER and !$pretext) {
		# Why are usernames in @user_completion prepended by `~'?
		push(@l, map { substr($_, 1) }
			 grep { /^~\Q$text/ } Psh::OS::get_all_users());
    }
    # job list
    if ($cs->{action} & CA_JOB and !$pretext) {
	push(@l,
	     map { $_->{call} }
	     grep { $_->{call} =~ /^\Q$text/ }
	      Psh::Joblist::list_jobs());
    }
    if ($cs->{action} & CA_RUNNING and !$pretext) {
	push(@l,
	     map { $_->{call} }
	     grep { $_->{running} && $_->{call} =~ /^\Q$text/ }
		 Psh::Joblist::list_jobs());
    }
    if ($cs->{action} & CA_STOPPED and !$pretext) {
	push(@l,
	     map { $_->{call} }
	     grep { ! $_->{running} && $_->{call} =~ /^\Q$text/ }
		 Psh::Joblist::list_jobs());
    }

    # Perl Symbol completions
#    printf "[$text,%08x]\n", $cs->{action};
	my $pkg = $Psh::PerlEval::current_package.'::';
    if ($cs->{action} & CA_VARIABLE and !$pretext) {
		no strict 'refs';
		push(@l, grep { /^\w+$/ && /^\Q$text/
						  && eval "defined \$$pkg$_" } keys %$pkg);
    }
    if ($cs->{action} & CA_ARRAYVAR and !$pretext) {
		my $sym;
		no strict 'refs';
		@l = grep {($sym = $pkg . $_, defined *$sym{ARRAY})
			   } keys %$pkg;
		push(@l,
			 grep { /^\Q$text/ }
			 grep { /^\w+$/ && ($sym = $pkg . $_, defined *$sym{ARRAY})
				} keys %$pkg);
    }
    if ($cs->{action} & CA_HASH and !$pretext) {
		my $sym;
		no strict 'refs';
		push(@l, grep { /^\w+$/ && /^\Q$text/
						  && ($sym = $pkg . $_, defined *$sym{HASH})
					  } keys %$pkg);
    }
    if ($cs->{action} & CA_FUNCTION and !$pretext) {
		my $sym;
		no strict 'refs';
		push(@l, grep { /^\w+$/ &&  /^\Q$text/
						  && ($sym = $pkg . $_, defined *$sym{CODE})
					  } keys %$pkg);
    }
	
    # -G glob
    # This does not work without modifying the specification of
    # Term::ReadLine::Perl::completion_function, which matches again
    # with globpattern.
#      if (defined $cs->{globpat}) {
#  	my $pat = glob2regexp($cs->{globpat});
#  	my $dir = $pretext || '.';
#  	opendir DIR, $dir
#  	    or warn "cannot open directory `$dir': $!\n", return ();
#  	my @d = readdir DIR;
#  	push(@l, grep(/$pat/, @d));
#  	closedir(DIR);
#      }

    # -W word list
    push(@l, grep { /^\Q$text/ } split(' ', $cs->{wordlist}))
	  if defined $cs->{wordlist} and !$pretext;

    # -F function
    if (defined $cs->{function} and !$pretext) {
		#	warn "[$text,$line,$start,$cmd]\n";
		$__line = $line; $__start = $start; $__cmd = $cmd; # for compgen()
		if ($cs->{function} =~/^(.*)\:\:[^:]+$/) {
			# Function is in a package, so try autoloading it
			my $package= $1;
			eval "require $package;";
		}
		my @t = eval {
			no strict 'refs';
			&{$cs->{functionpackage}.'::'.$cs->{function}}($text, $line, $start, $cmd);
		};
		if ($@) {
			warn $@;
		} else {
			push(@l, grep { /^\Q$text/ } @t);
		}
    }

    # -C command 
    if (defined $cs->{command} and !$pretext) {
		#	$ENV{COMP_LINE} = $line;
		#	$ENV{COMP_POINT} = $start;
		my $cmd = "$cs->{command}";
		# remove surrounding quotes
		$cmd =~ s/^\s*'(.*)'\s*$/$1/;
		$cmd =~ s/^\s*"(.*)"\s*$/$1/;
		push(@l, grep { chomp, /^\Q$text/ }
			 `$cmd "$text" "$line" "$start" "$cmd"`);
		warn "$0: $cs->{command}: command not found\n" if $?;
		#	$ENV{COMP_LINE} = $ENV{COMP_POINT} = undef;
    }
	
    # -X filter
    if (defined $cs->{filterpat}) {
		my $pat = $cs->{filterpat};
		#warn "[$pat";
		if ($pat =~ /^!/) {
			$pat = glob2regexp(substr($pat, 1));
			@l = grep(/$pat/, @l);
		} else {
			$pat = glob2regexp($pat);
			@l = grep(! /$pat/, @l);
		}
		#warn "->$pat]\n";
    }
	
    # -P prefix
    @l = map { $cs->{prefix} . $_ } @l if defined $cs->{prefix};
	
    # -S suffix
    @l = map { $_ . $cs->{suffix} } @l if defined $cs->{suffix};

	unshift @l,'';
    return @l;
}

########################################################################

sub pcomp_getopts {
    my $ar = $_[0];		# reference to an array of arguments
    my %cs;
    $cs{action} = 0;

    while (defined ($ar->[0]) and  $_ = $ar->[0], /^-/) {
	shift @{$ar};
	last if  /^--$/;
	if (/^-a/) {
	    $cs{action} |= CA_ALIAS;
	} elsif (/^-b/) {
	    $cs{action} |= CA_BUILTIN;
	} elsif (/^-c/) {
	    $cs{action} |= CA_COMMAND;
	} elsif (/^-d/) {
	    $cs{action} |= CA_DIRECTORY;
	} elsif (/^-e/) {
	    $cs{action} |= CA_EXPORT;
	} elsif (/^-f/) {
	    $cs{action} |= CA_FILE;
	} elsif (/^-j/) {
	    $cs{action} |= CA_JOB;
	} elsif (/^-k/) {
	    $cs{action} |= CA_KEYWORD;
	} elsif (/^-u/) {
	    $cs{action} |= CA_USER;
	} elsif (/^-v/) {
	    $cs{action} |= CA_VARIABLE;
	} elsif (/^-o/) {
		$cs{option}    = Psh::Parser::unquote(shift @{$ar});
	} elsif (/^-A/) {
	    $_ = Psh::Parser::unquote(shift @{$ar}) || return undef;
	    $cs{action} |= $ACTION{$_};
	} elsif (/^-G/) {
	    $cs{globpat}   = Psh::Parser::unquote(shift @{$ar});
	} elsif (/^-W/) {
	    $cs{wordlist}  = Psh::Parser::unquote(shift @{$ar});
	} elsif (/^-C/) {
	    $cs{command}   = Psh::Parser::unquote(shift @{$ar});
	} elsif (/^-F/) {
	    $cs{function}  = Psh::Parser::unquote(shift @{$ar});
		$cs{function_package}= $Psh::PerlEval::current_package;
	} elsif (/^-X/) {
	    $cs{filterpat} = Psh::Parser::unquote(shift @{$ar});
	} elsif (/^-x/) {	# psh specific (at least now)
	    $cs{ffilterpat} = Psh::Parser::unquote(shift @{$ar});
	} elsif (/^-P/) {
	    $cs{prefix}    = Psh::Parser::unquote(shift @{$ar});
	} elsif (/^-S/) {
	    $cs{suffix}    = Psh::Parser::unquote(shift @{$ar});
	} elsif (/^-p/) {
	    $cs{print}  = 1;
	} elsif (/^-r/) {
	    $cs{remove} = 1;
	} else {
	    return undef;
	}
    }
    return \%cs;
}

sub _redir_op {
    local $_ = shift;
    return 0 if /'[<>]'/;
    return 1 if /[<>]/;
    return 0;
}

sub redir_test {
    my($cur, $prev) = @_;

    if (_redir_op($cur)) {
        return compgen('-f', $cur);
    } elsif (_redir_op($prev)) {
        return compgen('-f', $cur);
    } else {
        return ();
    }
}

sub compgen {
	if (!@_ or !$_[0]) {
		usage_compgen();
		return undef;
	}
    my $cs = pcomp_getopts($_[0]) or usage_compgen(), return ;
    @_ = @{$_[0]};
    usage_compgen() if $cs->{print} or $cs->{remove} or $#_ > 1;

    pcomp_list($cs, $_[0] || '', $__line, $__start, $__cmd);
}

sub usage_compgen {
    print STDERR <<EOM;
compgen [-abcdefjkvu] [-A ACTION] [-G GLOBPAT] [-W WORDLIST]
	[-P PREFIX] [-S SUFFIX] [-X FILTERPAT] [-x FILTERPAT]
	[-F FUNCTION] [-C COMMAND] [WORD]
EOM
}

package main;

# compgen() routine is called by function which is assigned by `-F' option
# of complete command.
sub compgen {
    Psh::PCompletion::compgen(\@_);
}

1;
__END__
Commit	Line	Data
86530b38 AT	1	#
	2	# $Id: PCompletion.pm,v 1.20 2003/01/16 19:21:17 gregor Exp $
	3	#
	4	# Copyright (c) 2000-2003 Hiroo Hayashi. All Rights Reserved.
	5	#
	6	# This program is free software; you can redistribute it and/or
	7	# modify it under the same terms as Perl itself.
	8
	9	package Psh::PCompletion;
	10
	11	use strict;
	12	use vars qw(%COMPSPEC %ACTION @ISA @EXPORT_OK);
	13	require Exporter;
	14	require Psh::Completion;
	15	require Psh::Parser;
	16
	17	$Psh::PCompletion::LOADED=1; # tell other packages which optionally want to call us that we're here now
	18
	19	@ISA = qw(Exporter);
	20	@EXPORT_OK = qw(compgen);
	21
	22	# for COMPSPEC actions
	23	# borrowed from bash-2.04
	24	sub CA_ALIAS { 1<<0; }
	25	sub CA_ARRAYVAR { 1<<1; }
	26	sub CA_BINDING { 1<<2; }
	27	sub CA_BUILTIN { 1<<3; }
	28	sub CA_COMMAND { 1<<4; }
	29	sub CA_DIRECTORY { 1<<5; }
	30	sub CA_DISABLED { 1<<6; }
	31	sub CA_ENABLED { 1<<7; }
	32	sub CA_EXPORT { 1<<8; }
	33	sub CA_FILE { 1<<9; }
	34	sub CA_FUNCTION { 1<<10; }
	35	sub CA_HELPTOPIC { 1<<11; }
	36	sub CA_HOSTNAME { 1<<12; }
	37	sub CA_JOB { 1<<13; }
	38	sub CA_KEYWORD { 1<<14; }
	39	sub CA_RUNNING { 1<<15; }
	40	sub CA_SETOPT { 1<<16; }
	41	sub CA_SHOPT { 1<<17; }
	42	sub CA_SIGNAL { 1<<18; }
	43	sub CA_STOPPED { 1<<19; }
	44	sub CA_USER { 1<<20; }
	45	sub CA_VARIABLE { 1<<21; }
	46	# psh original
	47	sub CA_HASH { 1<<22; }
	48
	49	# pursing argments
	50	BEGIN {
	51	%ACTION
	52	= (alias => CA_ALIAS,
	53	arrayvar => CA_ARRAYVAR, # Perl array variable
	54	binding => CA_BINDING,
	55	builtin => CA_BUILTIN,
	56	command => CA_COMMAND,
	57	directory => CA_DIRECTORY,
	58	disabled => CA_DISABLED, # not implemented yet
	59	enabled => CA_ENABLED, # not implemented yet
	60	export => CA_EXPORT,
	61	file => CA_FILE,
	62	function => CA_FUNCTION, # Perl function
	63	helptopic => CA_HELPTOPIC,
	64	hostname => CA_HOSTNAME,
65	job => CA_JOB,
66	keyword => CA_KEYWORD,
67	running => CA_RUNNING,
68	setopt => CA_SETOPT, # not implemented yet
69	shopt => CA_SHOPT, # not implemented yet
70	signal => CA_SIGNAL,
71	stopped => CA_STOPPED,
72	user => CA_USER,
73	variable => CA_VARIABLE, # Perl variable
74	hashvar => CA_HASH, # Perl hash variable
75	);
76	}
77
78	my($__line, $__start, $__cmd);
79
80	# global variables for compgen()
81	#use vars qw($__line $__start $__cmd);
82
83	# convert from bash (and ksh?) extglob to Perl regular expression
84	sub glob2regexp {
85	local ($_) = @_;
86
87	# ?(...), (...), +(...) -> ()?, (), ()?
88	s/([^\\])([?+])\(([^)])\)/$1($3)$2/g;
89	s/^([?+])\(([^)])\)/($2)$1/g;
90
91	# @(...) -> (...)
92	s/([^\\])@\(([^)]*)\)/$1($2)/g;
93	s/^@\(([^)]*)\)/($1)/g;
94
95	# `!(...)' is not supported yet.
96
97	# '.' -> '\.'
98	s/([^\\])\./$1\\./g;
99	s/^\./\\./g;
100
101	# '' -> '.'
102	s/([^\\)])\/$1./g;
103	s/^\/./g;
104
105	# '$' -> '\$'
106	s/\$/\\\$/g;
107
108	return '^' . $_ . '$';
109	}
110
111	sub pcomp_list {
112	my ($cs, $text, $line, $start, $cmd) = @_;
113	my @l;
114
115	return () unless $line;
116	my ($pretext) = substr($line, 0, $start) =~ /(\S*)$/;
117
118	# actions
119	if ($cs->{action} & CA_ALIAS and !$pretext) {
120	if (Psh::Strategy::active('built_in')) {
121	push(@l, grep { /^\Q$text/ } Psh::Support::Alias::get_alias_commands());
122	}
123	}
124	if ($cs->{action} & CA_BINDING and !$pretext) {
125	# only Term::ReadLine::Gnu 1.09 and later support funmap_names()
126	# use `eval' for other versions
127	eval { push(@l, grep { /^\Q$text/ } $Psh::term->funmap_names) };
128	Psh::Util::print_debug_class('e',"Error: $@") if $@;
129	}
130	if ($cs->{action} & CA_BUILTIN \|\| $cs->{action} & CA_HELPTOPIC) {
131	if (Psh::Strategy::active('built_in')) {
132	push(@l, grep { /^\Q$text/ } Psh::Support::Builtins::get_builtin_commands());
133	}
134	}
135	if ($cs->{action} & CA_COMMAND and !$pretext) {
136	push(@l, Psh::Completion::cmpl_executable($text));
137	}
138	if ($cs->{action} & CA_DIRECTORY) {
139	push(@l, Psh::Completion::cmpl_directories($pretext . $text));
140	}
141	if ($cs->{action} & CA_EXPORT and !$pretext) {
142	push(@l, grep { /^\Q$text/ } keys %ENV);
143	}
144	if ($cs->{action} & CA_FILE) {
145	my @f = Psh::Completion::cmpl_filenames($pretext . $text);
146	if (defined $cs->{ffilterpat}) {
147	my $pat = $cs->{ffilterpat};
148	if ($pat =~ /^!/) {
149	$pat = glob2regexp(substr($pat, 1));
150	@f = grep(/$pat/, @f);
151	} else {
152	$pat = glob2regexp($pat);
153	@f = grep(! /$pat/, @f);
154	}
155	}
156	push(@l, @f);
157	push(@l, Psh::Completion::cmpl_directories($pretext . $text));
158	}
159	if ($cs->{action} & CA_HOSTNAME and !$pretext) {
160	push(@l, grep { /^\Q$text/ } Psh::Completion::bookmarks());
161	}
162	if ($cs->{action} & CA_KEYWORD and !$pretext) {
163	push(@l, grep { /^\Q$text/ } @Psh::Completion::keyword);
164	}
165	if ($cs->{action} & CA_SIGNAL and !$pretext) {
166	push(@l, grep { /^\Q$text/ } grep(!/^__/, keys %SIG));
167	}
168	if ($cs->{action} & CA_USER and !$pretext) {
169	# Why are usernames in @user_completion prepended by `~'?
170	push(@l, map { substr($_, 1) }
171	grep { /^~\Q$text/ } Psh::OS::get_all_users());
172	}
173	# job list
174	if ($cs->{action} & CA_JOB and !$pretext) {
175	push(@l,
176	map { $_->{call} }
177	grep { $_->{call} =~ /^\Q$text/ }
178	Psh::Joblist::list_jobs());
179	}
180	if ($cs->{action} & CA_RUNNING and !$pretext) {
181	push(@l,
182	map { $_->{call} }
183	grep { $_->{running} && $_->{call} =~ /^\Q$text/ }
184	Psh::Joblist::list_jobs());
185	}
186	if ($cs->{action} & CA_STOPPED and !$pretext) {
187	push(@l,
188	map { $_->{call} }
189	grep { ! $_->{running} && $_->{call} =~ /^\Q$text/ }
190	Psh::Joblist::list_jobs());
191	}
192
193	# Perl Symbol completions
194	# printf "[$text,%08x]\n", $cs->{action};
195	my $pkg = $Psh::PerlEval::current_package.'::';
196	if ($cs->{action} & CA_VARIABLE and !$pretext) {
197	no strict 'refs';
198	push(@l, grep { /^\w+$/ && /^\Q$text/
199	&& eval "defined \$$pkg$_" } keys %$pkg);
200	}
201	if ($cs->{action} & CA_ARRAYVAR and !$pretext) {
202	my $sym;
203	no strict 'refs';
204	@l = grep {($sym = $pkg . $_, defined *$sym{ARRAY})
205	} keys %$pkg;
206	push(@l,
207	grep { /^\Q$text/ }
208	grep { /^\w+$/ && ($sym = $pkg . $_, defined *$sym{ARRAY})
209	} keys %$pkg);
210	}
211	if ($cs->{action} & CA_HASH and !$pretext) {
212	my $sym;
213	no strict 'refs';
214	push(@l, grep { /^\w+$/ && /^\Q$text/
215	&& ($sym = $pkg . $_, defined *$sym{HASH})
216	} keys %$pkg);
217	}
218	if ($cs->{action} & CA_FUNCTION and !$pretext) {
219	my $sym;
220	no strict 'refs';
221	push(@l, grep { /^\w+$/ && /^\Q$text/
222	&& ($sym = $pkg . $_, defined *$sym{CODE})
223	} keys %$pkg);
224	}
225
226	# -G glob
227	# This does not work without modifying the specification of
228	# Term::ReadLine::Perl::completion_function, which matches again
229	# with globpattern.
230	# if (defined $cs->{globpat}) {
231	# my $pat = glob2regexp($cs->{globpat});
232	# my $dir = $pretext \|\| '.';
233	# opendir DIR, $dir
234	# or warn "cannot open directory `$dir': $!\n", return ();
235	# my @d = readdir DIR;
236	# push(@l, grep(/$pat/, @d));
237	# closedir(DIR);
238	# }
239
240	# -W word list
241	push(@l, grep { /^\Q$text/ } split(' ', $cs->{wordlist}))
242	if defined $cs->{wordlist} and !$pretext;
243
244	# -F function
245	if (defined $cs->{function} and !$pretext) {
246	# warn "[$text,$line,$start,$cmd]\n";
247	$__line = $line; $__start = $start; $__cmd = $cmd; # for compgen()
248	if ($cs->{function} =~/^(.*)\:\:[^:]+$/) {
249	# Function is in a package, so try autoloading it
250	my $package= $1;
251	eval "require $package;";
252	}
253	my @t = eval {
254	no strict 'refs';
255	&{$cs->{functionpackage}.'::'.$cs->{function}}($text, $line, $start, $cmd);
256	};
257	if ($@) {
258	warn $@;
259	} else {
260	push(@l, grep { /^\Q$text/ } @t);
261	}
262	}
263
264	# -C command
265	if (defined $cs->{command} and !$pretext) {
266	# $ENV{COMP_LINE} = $line;
267	# $ENV{COMP_POINT} = $start;
268	my $cmd = "$cs->{command}";
269	# remove surrounding quotes
270	$cmd =~ s/^\s'(.)'\s*$/$1/;
271	$cmd =~ s/^\s"(.)"\s*$/$1/;
272	push(@l, grep { chomp, /^\Q$text/ }
273	`$cmd "$text" "$line" "$start" "$cmd"`);
274	warn "$0: $cs->{command}: command not found\n" if $?;
275	# $ENV{COMP_LINE} = $ENV{COMP_POINT} = undef;
276	}
277
278	# -X filter
279	if (defined $cs->{filterpat}) {
280	my $pat = $cs->{filterpat};
281	#warn "[$pat";
282	if ($pat =~ /^!/) {
283	$pat = glob2regexp(substr($pat, 1));
284	@l = grep(/$pat/, @l);
285	} else {
286	$pat = glob2regexp($pat);
287	@l = grep(! /$pat/, @l);
288	}
289	#warn "->$pat]\n";
290	}
291
292	# -P prefix
293	@l = map { $cs->{prefix} . $_ } @l if defined $cs->{prefix};
294
295	# -S suffix
296	@l = map { $_ . $cs->{suffix} } @l if defined $cs->{suffix};
297
298	unshift @l,'';
299	return @l;
300	}
301
302	########################################################################
303
304	sub pcomp_getopts {
305	my $ar = $_[0]; # reference to an array of arguments
306	my %cs;
307	$cs{action} = 0;
308
309	while (defined ($ar->[0]) and $_ = $ar->[0], /^-/) {
310	shift @{$ar};
311	last if /^--$/;
312	if (/^-a/) {
313	$cs{action} \|= CA_ALIAS;
314	} elsif (/^-b/) {
315	$cs{action} \|= CA_BUILTIN;
316	} elsif (/^-c/) {
317	$cs{action} \|= CA_COMMAND;
318	} elsif (/^-d/) {
319	$cs{action} \|= CA_DIRECTORY;
320	} elsif (/^-e/) {
321	$cs{action} \|= CA_EXPORT;
322	} elsif (/^-f/) {
323	$cs{action} \|= CA_FILE;
324	} elsif (/^-j/) {
325	$cs{action} \|= CA_JOB;
326	} elsif (/^-k/) {
327	$cs{action} \|= CA_KEYWORD;
328	} elsif (/^-u/) {
329	$cs{action} \|= CA_USER;
330	} elsif (/^-v/) {
331	$cs{action} \|= CA_VARIABLE;
332	} elsif (/^-o/) {
333	$cs{option} = Psh::Parser::unquote(shift @{$ar});
334	} elsif (/^-A/) {
335	$_ = Psh::Parser::unquote(shift @{$ar}) \|\| return undef;
336	$cs{action} \|= $ACTION{$_};
337	} elsif (/^-G/) {
338	$cs{globpat} = Psh::Parser::unquote(shift @{$ar});
339	} elsif (/^-W/) {
340	$cs{wordlist} = Psh::Parser::unquote(shift @{$ar});
341	} elsif (/^-C/) {
342	$cs{command} = Psh::Parser::unquote(shift @{$ar});
343	} elsif (/^-F/) {
344	$cs{function} = Psh::Parser::unquote(shift @{$ar});
345	$cs{function_package}= $Psh::PerlEval::current_package;
346	} elsif (/^-X/) {
347	$cs{filterpat} = Psh::Parser::unquote(shift @{$ar});
348	} elsif (/^-x/) { # psh specific (at least now)
349	$cs{ffilterpat} = Psh::Parser::unquote(shift @{$ar});
350	} elsif (/^-P/) {
351	$cs{prefix} = Psh::Parser::unquote(shift @{$ar});
352	} elsif (/^-S/) {
353	$cs{suffix} = Psh::Parser::unquote(shift @{$ar});
354	} elsif (/^-p/) {
355	$cs{print} = 1;
356	} elsif (/^-r/) {
357	$cs{remove} = 1;
358	} else {
359	return undef;
360	}
361	}
362	return \%cs;
363	}
364
365	sub _redir_op {
366	local $_ = shift;
367	return 0 if /'[<>]'/;
368	return 1 if /[<>]/;
369	return 0;
370	}
371
372	sub redir_test {
373	my($cur, $prev) = @_;
374
375	if (_redir_op($cur)) {
376	return compgen('-f', $cur);
377	} elsif (_redir_op($prev)) {
378	return compgen('-f', $cur);
379	} else {
380	return ();
381	}
382	}
383
384	sub compgen {
385	if (!@_ or !$_[0]) {
386	usage_compgen();
387	return undef;
388	}
389	my $cs = pcomp_getopts($_[0]) or usage_compgen(), return ;
390	@_ = @{$_[0]};
391	usage_compgen() if $cs->{print} or $cs->{remove} or $#_ > 1;
392
393	pcomp_list($cs, $_[0] \|\| '', $__line, $__start, $__cmd);
394	}
395
396	sub usage_compgen {
397	print STDERR <<EOM;
398	compgen [-abcdefjkvu] [-A ACTION] [-G GLOBPAT] [-W WORDLIST]
399	[-P PREFIX] [-S SUFFIX] [-X FILTERPAT] [-x FILTERPAT]
400	[-F FUNCTION] [-C COMMAND] [WORD]
401	EOM
402	}
403
404	package main;
405
406	# compgen() routine is called by function which is assigned by `-F' option
407	# of complete command.
408	sub compgen {
409	Psh::PCompletion::compgen(\@_);
410	}
411
412	1;
413	__END__