aboutsummaryrefslogtreecommitdiff
path: root/Perl/ZincText.pm
blob: 2785b392f8ead5f4c2ba33cb73a7dafc51d77506 (plain)
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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93

package ZincText;


sub new {
  my $proto = shift;
  my $type = ref($proto) || $proto;
  my ($zinc) = @_;
  my $self = {};

  $zinc->bind('text', '<1>' => sub {startSel($zinc)});
  $zinc->bind('text', '<B1-Motion>' => sub {extendSel($zinc)});
  $zinc->bind('text', '<Shift-B1-Motion>' => sub {extendSel($zinc)});
  $zinc->bind('text', '<Shift-1>' => sub {
		my $e = $zinc->XEvent();
		my($x, $y) = ($e->x, $e->y);
		$zinc->select('adjust', 'current', "\@$x,$y"); });
  $zinc->bind('text', '<Left>' => sub {moveCur($zinc, -1);});
  $zinc->bind('text', '<Right>' => sub {moveCur($zinc, 1);});
  $zinc->bind('text', '<Control-a>' => sub {setCur($zinc, 0);});
  $zinc->bind('text', '<Home>' => sub {setCur($zinc, 0);});
  $zinc->bind('text', '<Control-e>' => sub {setCur($zinc, 'end');});
  $zinc->bind('text', '<End>' => sub {setCur($zinc, 'end');});
  $zinc->bind('text', '<KeyPress>' => sub {insertChar($zinc);});
  $zinc->bind('text', '<Shift-KeyPress>' => sub {insertChar($zinc);});
  $zinc->bind('text', '<Return>' => sub {
		$zinc->insert($zinc->focus(), 'insert', "\n"); });
  $zinc->bind('text', '<BackSpace>' => sub {textDel($zinc, -1)});
  $zinc->bind('text', '<Delete>' => sub {textDel($zinc, 0)});
  $zinc->bind('text', '<Control-d>' => sub {
		$zinc->dchars($zinc->focus(), 'sel.first', 'sel.last'); });
  $zinc->bind('text', '<Control-y>' => sub {
		$zinc->insert($zinc->focus(), 'insert', Tk::selection('get')); });

  bless ($self, $type);
  return $self;
}


sub insertChar {
  my ($w) = @_;
  my $c = $w->XEvent->A();

  $w->insert($w->focus(), 'insert', $c);
}


sub setCur {
  my ($w, $where) = @_;
  my $it = $w->focus();

  $w->cursor($it, $where);
}


sub moveCur {
  my ($w, $dir) = @_;
  my $it = $w->focus();
  my $index = $w->index($it, 'insert');

  $w->cursor($it, $index + $dir);
}


sub startSel {
  my($w) = @_;
  my $e = $w->XEvent;
  my($x, $y) = ($e->x, $e->y);

  $w->cursor('current', "\@$x,$y");
  $w->focus('current');
  $w->Tk::focus;
  $w->select('from', 'current', "\@$x,$y");
}


sub extendSel {
  my($w) = @_;
  my $e = $w->XEvent;
  my($x, $y) = ($e->x, $e->y);
  $w->select('to', 'current', "\@$x,$y");
}


sub textDel {
  my($w, $dir) = @_;
  my $it = $w->focus();
  my $ind = $w->index($it, 'insert') + $dir;

  $w->dchars($it, $ind) if ($ind >= 0);
}

1;