File: tietext

package info (click to toggle)
perl-tk 1:800.025-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 18,444 kB
  • ctags: 19,081
  • sloc: ansic: 206,740; perl: 40,187; makefile: 4,371; sh: 2,373; yacc: 762
file content (74 lines) | stat: -rwxr-xr-x 1,207 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
#!/usr/local/bin/perl -w
use Tk;

{package Tk::Text::Contents;

 sub TIEARRAY
 {
  print "TIEARRAY(",join(',',@_),")\n";
  my ($class,$text) = @_;
  return bless [$text],$class;
 }

 sub FETCH
 {
# print "FETCH(",join(',',@_),")\n";
  my ($obj,$key) = @_;
  my $text = ${$obj}[0]; 
  $key++;
  return $text->get($key.".0" ,$key.".0+1 line");
 }

 sub STORE
 {
#  print "STORE(",join(',',@_),")\n";
  my ($obj,$key,$val) = @_;
  my $text = ${$obj}[0]; 
  $key++;
  while ($text->compare($key.".0",'>','end'))
   {
    $text->insert('end',"\n");
   }
  if ($text->compare($key.".0+1 line",'<','end'))
   {
    $text->delete($key. ".0" ,$key.".0+1 line");
   }
# $val .= "\n" unless ($val =~ /\n$/);
  chomp($val);
  $text->insert($key . ".0" ,$val."\n");
  print "$key:$val\n";
  $text->update; 
 }

 sub LENGTH
 {
  my ($obj) = @_;
  my $text = ${$obj}[0]; 
  print $text->index("end"),"\n";
  my ($line,$col) = split(/\./,$text->index("end"));
  $line -= 3;
  return $line;
 }

}

$top = MainWindow->new;

$text = $top->Text;
$text->pack;

tie @lines,Tk::Text::Contents,$text;


@lines = <>;

my $line;

foreach $line (@lines)
 {
#   print "Got $_";
#  $line = "New:" . $line;
   s/^/Added:/;
 }

MainLoop;