|
996
|
1 package Language::INTERCAL::Interface::None;
|
|
|
2
|
|
|
3 # pseudo user interface which never enters interactive mode
|
|
|
4
|
|
|
5 # This file is part of CLC-INTERCAL
|
|
|
6
|
|
|
7 # Copyright (c) 2006-2008 Claudio Calvelli, all rights reserved.
|
|
|
8
|
|
|
9 # CLC-INTERCAL is copyrighted software. However, permission to use, modify,
|
|
|
10 # and distribute it is granted provided that the conditions set out in the
|
|
|
11 # licence agreement are met. See files README and COPYING in the distribution.
|
|
|
12
|
|
|
13 use strict;
|
|
|
14 use vars qw($VERSION $PERVERSION);
|
|
|
15 ($VERSION) = ($PERVERSION = "CLC-INTERCAL/Base INTERCAL/Interface/None.pm 1.-94.-2") =~ /\s(\S+)$/;
|
|
|
16
|
|
|
17 use Carp;
|
|
|
18 use Language::INTERCAL::Exporter '1.-94.-2';
|
|
|
19 use Language::INTERCAL::GenericIO '1.-94.-2', qw($stdread $stdwrite);
|
|
|
20
|
|
|
21 sub new {
|
|
|
22 @_ == 2 or croak "Usage: Language::INTERCAL::Interface::None->new(SERVER)";
|
|
|
23 my ($class, $server) = @_;
|
|
|
24 my $none = bless {
|
|
|
25 server => $server,
|
|
|
26 line => '',
|
|
|
27 end => 0,
|
|
|
28 }, $class;
|
|
|
29 $| = 1;
|
|
|
30 if ($server) {
|
|
|
31 STDIN->blocking(0);
|
|
|
32 $server->file_listen(fileno(STDIN),
|
|
|
33 sub {
|
|
|
34 my $l;
|
|
|
35 if (sysread STDIN, $l, 1024) {
|
|
|
36 $none->{line} .= $l;
|
|
|
37 } else {
|
|
|
38 $none->{end} = 1;
|
|
|
39 $server->file_listen_close(fileno(STDIN));
|
|
|
40 }
|
|
|
41 });
|
|
|
42 }
|
|
|
43 $none;
|
|
|
44 }
|
|
|
45
|
|
|
46 sub has_window { 0 }
|
|
|
47 sub is_interactive { 0 }
|
|
|
48
|
|
|
49 sub is_terminal {
|
|
|
50 $stdwrite->is_terminal;
|
|
|
51 }
|
|
|
52
|
|
|
53 sub run {
|
|
|
54 croak "Non interactive interface should never enter run()";
|
|
|
55 }
|
|
|
56
|
|
|
57 sub start {
|
|
|
58 croak "Non interactive interface should never enter start()";
|
|
|
59 }
|
|
|
60
|
|
|
61 sub stdread {
|
|
|
62 $stdread;
|
|
|
63 }
|
|
|
64
|
|
|
65 sub getline {
|
|
|
66 @_ == 2 or croak "Usage: NONE->getline(PROMPT)";
|
|
|
67 my ($none, $prompt) = @_;
|
|
|
68 $stdread->read_text($prompt);
|
|
|
69 my $timeout = 0;
|
|
|
70 while (1) {
|
|
|
71 $none->{server}->progress($timeout);
|
|
|
72 $timeout = undef;
|
|
|
73 $none->{line} =~ s/^(.*?\n)// and return $1;
|
|
|
74 $none->{end} or next;
|
|
|
75 my $l = $none->{line};
|
|
|
76 $none->{line} = undef;
|
|
|
77 return $l;
|
|
|
78 }
|
|
|
79 }
|
|
|
80
|
|
|
81 sub complete {
|
|
|
82 @_ == 1 || @_ == 2 or croak "Usage: NONE->complete [(CALLBACK)]";
|
|
|
83 my ($none, $code) = @_;
|
|
|
84 $none;
|
|
|
85 }
|
|
|
86
|
|
|
87 1;
|
