WeakNet Code Paste Repository

1. package ChartComplete;

2. require 5.000;

3. require Exporter;

5. use strict;

6. our @ISA = qw(Exporter);

7. our @EXPORT = qw(Complete);

8. our $VERSION = '1.4021';

10. # @(#)complete.pl,v1.2 (me@anywhere.EBay.Sun.COM) 09/23/91

11.

12. =head1 NAME

13.

14. Term::Complete - Perl word completion module

15. Modified by Chartreuse to catch ctrl-c

16. =head1 SYNOPSIS

17.

18. $input = Complete('prompt_string', \@completion_list);

19. $input = Complete('prompt_string', @completion_list);

20.

21. =head1 DESCRIPTION

22.

23. This routine provides word completion on the list of words in

24. the array (or array ref).

25.

26. The tty driver is put into raw mode and restored using an operating

27. system specific command, in UNIX-like environments C<stty>.

28.

29. The following command characters are defined:

30.

31. =over 4

32.

33. =item E<lt>tabE<gt>

34.

35. Attempts word completion.

36. Cannot be changed.

37.

38. =item ^D

39.

40. Prints completion list.

41. Defined by I<$Term::Complete::complete>.

42.

43. =item ^U

44.

45. Erases the current input.

46. Defined by I<$Term::Complete::kill>.

47.

48. =item E<lt>delE<gt>, E<lt>bsE<gt>

49.

50. Erases one character.

51. Defined by I<$Term::Complete::erase1> and I<$Term::Complete::erase2>.

52.

53. =back

54.

55. =head1 DIAGNOSTICS

56.

57. Bell sounds when word completion fails.

58.

59. =head1 BUGS

60.

61. The completion character E<lt>tabE<gt> cannot be changed.

62.

63. =head1 AUTHOR

64.

65. Wayne Thompson

66.

67. =cut

68.

69. our($ctrlc, $complete, $kill, $erase1, $erase2, $tty_raw_noecho, $tty_restore, $stty, $tty_safe_restore);

70. our($tty_saved_state) = '';

71. CONFIG: {

72. $complete = "\004";

73. $kill = "\025";

74. $erase1 = "\177";

75. $erase2 = "\010";

76. $ctrlc = "\003";

77. foreach my $s (qw(/bin/stty /usr/bin/stty)) {

78. if (-x $s) {

79. $tty_raw_noecho = "$s raw -echo";

80. $tty_restore = "$s -raw echo";

81. $tty_safe_restore = $tty_restore;

82. $stty = $s;

83. last;

84. }

85. }

86. }

87.

88. sub Complete {

89. my($prompt, @cmp_lst, $cmp, $test, $l, @match);

90. my ($return, $r) = ("", 0);

91.

92. $return = "";

93. $r = 0;

94.

95. $prompt = shift;

96. if (ref $_[0] || $_[0] =~ /^\*/) {

97. @cmp_lst = sort @{$_[0]};

98. }

99. else {

100. @cmp_lst = sort(@_);

101. }

102.

103. # Attempt to save the current stty state, to be restored later

104. if (defined $stty && defined $tty_saved_state && $tty_saved_state eq '') {

105. $tty_saved_state = qx($stty -g 2>/dev/null);

106. if ($?) {

107. # stty -g not supported

108. $tty_saved_state = undef;

109. }

110. else {

111. $tty_saved_state =~ s/\s+$//g;

112. $tty_restore = qq($stty "$tty_saved_state" 2>/dev/null);

113. }

114. }

115. system $tty_raw_noecho if defined $tty_raw_noecho;

116. LOOP: {

117. local $_;

118. print($prompt, $return);

119. while (($_ = getc(STDIN)) ne "\r") {

120. CASE: {

121. # (TAB) attempt completion

122. $_ eq "\t" && do {

123. @match = grep(/^\Q$return/, @cmp_lst);

124. unless ($#match < 0) {

125. $l = length($test = shift(@match));

126. foreach $cmp (@match) {

127. until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {

128. $l--;

129. }

130. }

131. print("\a");

132. print($test = substr($test, $r, $l - $r));

133. $r = length($return .= $test);

134. }

135. last CASE;

136. };

137.

138. # (^D) completion list

139. $_ eq $complete && do {

140. print(join("\r\n", '', grep(/^\Q$return/, @cmp_lst)), "\r\n");

141. redo LOOP;

142. };

143.

144. # (^U) kill

145. $_ eq $kill && do {

146. if ($r) {

147. $r = 0;

148. $return = "";

149. print("\r\n");

150. redo LOOP;

151. }

152. last CASE;

153. };

154. # SIGINT (Ctrl-C) detection -- Added by Chartreuse

155. $_ eq $ctrlc && do {

156. system $tty_restore;

157. if ($?) {

158. # tty_restore caused error

159. system $tty_safe_restore;

160. }

161. &{$SIG{INT}};

162. last CASE;

163. };

164. # (DEL) || (BS) erase

165. ($_ eq $erase1 || $_ eq $erase2) && do {

166. if($r) {

167. print("\b \b");

168. chop($return);

169. $r--;

170. }

171. last CASE;

172. };

173.

174. # printable char

175. ord >= 32 && do {

176. $return .= $_;

177. $r++;

178. print;

179. last CASE;

180. };

181. }

182. }

183. }

184.

185. # system $tty_restore if defined $tty_restore;

186. if (defined $tty_saved_state && defined $tty_restore && defined $tty_safe_restore)

187. {

188. system $tty_restore;

189. if ($?) {

190. # tty_restore caused error

191. system $tty_safe_restore;

192. }

193. }

194. print("\n");

195. $return;

196. }

197.

198. 1;