summaryrefslogtreecommitdiffstats
path: root/lib/Language/TECO/Buffer.pm
blob: 54d09816d8891e3f3d158976e6955bf1344755cf (plain) (blame)
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
94
95
96
97
98
99
100
101
102
103
104
105
package Language::TECO::Buffer;
use Moose;
use namespace::autoclean;

has _buffer => (
    traits   => ['String'],
    is       => 'rw',
    isa      => 'Str',
    default  => '',
    init_arg => 'buffer',
    handles  => {
        _substr_buffer => 'substr',
        endpos         => 'length',
    },
);

has curpos => (
    traits  => ['Counter'],
    is      => 'rw',
    isa     => 'Int',
    default => 0,
    trigger => sub {
        my $self = shift;
        my ($curpos, $oldpos) = @_;
        # XXX: ick, do this better
        if ($curpos < 0 || $curpos > $self->endpos) {
            $self->curpos($oldpos);
            die "Pointer off page\n";
        }
    },
    handles => {
        set    => 'set',
        offset => 'inc',
    },
);

around BUILDARGS => sub {
    my $orig = shift;
    my $class = shift;
    shift if !defined($_[0]);
    unshift @_, 'buffer' if @_ % 2 == 1;
    return $class->$orig(@_);
};

around qw(set offset) => sub {
    my $orig = shift;
    my $self = shift;
    $self->$orig(@_);
    return;
};

sub buffer {
    my $self = shift;
    my ($start, $end) = @_;
    $start = 0             if !defined $start || $start < 0;
    $end   = $self->endpos if !defined $end   || $end > $self->endpos;
    ($start, $end) = ($end, $start) if $start > $end;
    return $self->_substr_buffer($start, $end - $start);
}

sub insert {
    my $self = shift;
    my ($text) = @_;
    $self->_substr_buffer($self->curpos, 0, $text);
    $self->offset(length $text);
    return;
}

sub delete {
    my $self = shift;
    my ($start, $end) = @_;
    ($start, $end) = ($end, $start) if $start > $end;

    die "Pointer off page\n" if $start < 0 || $end > $self->endpos;
    $self->_substr_buffer($start, $end - $start, '');
    $self->set($start);
    return;
}

sub get_line_offset {
    my $self = shift;
    my $num = shift;

    # XXX: what in the world was i thinking... clean this up
    if ($num > 0) {
        my $buffer = $self->buffer;
        pos $buffer = $self->curpos;
        $buffer =~ /(?:.*(?:\n|$)){0,$num}/g;
        return ($-[0], $+[0]) if wantarray;
        return $+[0];
    }
    else {
        $num = -$num;
        my $rev = reverse $self->buffer;
        my $len = $self->endpos;
        pos $rev = $len - $self->curpos;
        $rev =~ /.*?(?:\n.*?){0,$num}(?=\n|$)/g;
        return ($len - $+[0], $len - $-[0]) if wantarray;
        return $len - $+[0];
    }
}

__PACKAGE__->meta->make_immutable;

1;