Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: d93fffe32b
104 lines (90 sloc) 2.602 kb
# Cursor.pm
#
# Copyright 2007-2010, Larry Wall
#
# You may copy this software under the terms of the Artistic License,
# version 2.0 or later.
use CursorBase;
class Cursor is CursorBase;
our $BLUE = $CursorBase::BLUE;
our $GREEN = $CursorBase::GREEN;
our $CYAN = $CursorBase::CYAN;
our $MAGENTA = $CursorBase::MAGENTA;
our $YELLOW = $CursorBase::YELLOW;
our $RED = $CursorBase::RED;
our $CLEAR = $CursorBase::CLEAR;
method panic (Str $s) {
self.deb("panic $s") if $*DEBUG;
my $m;
my $here = self;
$m ~= $s;
$m ~= $here.locmess;
$m ~= "\n" unless $m ~~ /\n$/;
note $Cursor::RED, '===', $Cursor::CLEAR, 'SORRY!', $Cursor::RED, '===', $Cursor::CLEAR, "\n";
note $m;
die "Parse failed\n";
}
method worry (Str $s) {
my $m = $s ~ self.locmess;
push @*WORRIES, $m unless %*WORRIES{$s}++;
self;
}
method sorry (Str $s) {
self.deb("sorry $s") if $*DEBUG;
note $Cursor::RED, '===', $Cursor::CLEAR, 'SORRY!', $Cursor::RED, '===', $Cursor::CLEAR, "\n"
unless $*IN_SUPPOSE or $*FATALS++;
if $s {
my $m = $s;
$m ~= self.locmess ~ "\n" unless $m ~~ /\n$/;
if $*FATALS > 10 or $*IN_SUPPOSE {
die $m;
}
else {
note $m unless %*WORRIES{$m}++;
}
}
self;
}
method locmess () {
my $pos = self.pos;
my $line = self.lineof($pos);
# past final newline?
if $pos >= @*MEMOS - 1 {
$pos = $pos - 1;
$line = $line ~ " (EOF)";
}
my $pre = substr($*ORIG, 0, $pos);
$pre = substr($pre, -40, 40);
1 while $pre ~~ s!.*\n!!;
$pre = '<BOL>' if $pre eq '';
my $post = substr($*ORIG, $pos, 40);
1 while $post ~~ s!(\n.*)!!;
$post = '<EOL>' if $post eq '';
" at " ~ $*FILE<name> ~ " line $line:\n------> " ~ $Cursor::GREEN ~ $pre ~ $Cursor::YELLOW ~ $*PERL6HERE ~ $Cursor::RED ~
"$post$Cursor::CLEAR";
}
method line {
self.lineof(self.pos);
}
method lineof ($p) {
return 1 unless defined $p;
my $line = @*MEMOS[$p]<L>;
return $line if $line;
$line = 0;
my $pos = 0;
my @text = split(/^/,$*ORIG); # XXX p5ism, should be ^^
for @text {
$line++;
@*MEMOS[$pos++]<L> = $line
for 1 .. chars($_);
}
@*MEMOS[$pos++]<L> = $line;
return @*MEMOS[$p]<L> // 0;
}
method SETGOAL { }
method FAILGOAL (Str $stop, Str $name, $startpos) {
my $s = "'$stop'";
$s = '"\'"' if $s eq "'''";
self.panic("Unable to parse $name" ~ $startpos.locmess ~ "\nCouldn't find final $s; gave up");
}
## vim: expandtab sw=4 ft=perl6
Jump to Line
Something went wrong with that request. Please try again.