pmacs3/mode/perl.py

import os
import re
import string
from subprocess import Popen, PIPE, STDOUT
import completer
import context
from mode import Fundamental
import regex
from buffer import IperlBuffer
from point import Point
from lex import Grammar, LazyPatternRule, PatternRule, ContextPatternRule, RegionRule
from lex import OverridePatternRule, PatternMatchRule
from method import Argument, Method, WrapParagraph, arg
from method.introspect import TokenComplete
from tab import StackTabber2
from parse import Any, And, Or, Optional, Name, Match, Matchs
import term

strg1 = r"'(?:\\.|[^'\\])*'"
strg2 = r'"(?:\\.|[^"\\])*"'
wchr1 = '[a-zA-Z_]'
wchr2 = '[a-zA-Z0-9_]'
wchr3 = '[-a-zA-Z0-9_]'
hword = wchr3 + '+'
word1 = wchr1 + wchr2 + '*'
word2 = '(?:' + word1 + "(?:'|::))*" + word1
pname = '[.a-zA-Z0-9_]+'

spaces = PatternRule('spaces', '[\t ]+')
eol    = PatternRule('eol', r'\n')
length = PatternRule('perl.length', r"\$#" + word2)

class PerlGrammar(Grammar):
    pass

class WhitespaceGrammar(Grammar):
    rules = [spaces, eol]

class PodDataGrammar(Grammar):
    rules = [PatternRule(r'data', r'[^\n]+\n$')]

class PodGrammar(Grammar):
    rules = [
        RegionRule('entry', '(?<=^=head[1-4]) +.*$', PodDataGrammar, r'^\n$'),
        RegionRule('entry', '(?<=^=over) +.*$', PodDataGrammar, r'^\n$'),
        RegionRule('entry', '(?<=^=item) +.*$', PodDataGrammar, r'^\n$'),
        RegionRule('entry', '(?:(?<=^=begin)|(?<=^=end)) +.*$', PodDataGrammar, r'^\n$'),
        RegionRule('entry', '(?<=^=encoding) +.*$', PodDataGrammar, r'^\n$'),
    ]

scalar_rules = [
    PatternRule('perl.array', r"\@(?= *{)"),
    PatternRule('perl.array', r'\@[_\+\-]'),
    PatternRule('perl.array', r"\@\$*" + word2),
    PatternRule('perl.array', r'\$' + word2 + '(?=\[)'),
    PatternRule('perl.array', r"\$(?= *\[)"),

    PatternRule('perl.hash', r"\%(?= *{)"),
    PatternRule('perl.hash', r'\%(?:[!]|^H)'),
    PatternRule('perl.hash', r"\%\$*" + word2),
    PatternRule('perl.hash', r'\$' + word2 + '(?= *\{)'),
    PatternRule('perl.hash', r"\$(?= *{)"),

    PatternRule('perl.scalar', r'\$[_&`\'\+\*\.|,\\";#\%=\-~\^:\?!@\$<>()\[\]](?!' + wchr2 + ')'),
    PatternRule('perl.scalar', r'\$\d+(?!' + wchr2 +')'),
    PatternRule('perl.scalar', r'\$\^(?:' + word1 + '|' + wchr1 + ')'),
    PatternRule('perl.scalar', r'\$\^O'),
    PatternRule('perl.scalar', r'\${\^' + word1 + '}'),
    PatternRule('perl.scalar', r'\$+' + word2),
]

def _make_string_rules(forbidden):
    rules = [
        PatternRule('octal', r'\\[0-7]{3}'),
        PatternRule('escaped', r'\\.'),
        PatternRule('perl.deref', r"\$+" + word2 + "(?:" + "(?:->)?{\$?(?:" +
                    hword + "|" + strg1 + "|" + strg2 + ")}|" +
                    "(?:->)?\[\$?"+hword+"\]"+ ")+"),
        length,
    ] + scalar_rules

    if not forbidden:
        rules.insert(0, LazyPatternRule('data', "\$(?=%(delim)s)"))
    elif forbidden in '()[].+*|?^':
        rules.insert(0, PatternRule('data', "\\$(?=\\" + forbidden + ')'))
    else:
        rules.insert(0, PatternRule('data', "\\$(?=" + forbidden + ')'))

    if forbidden != '/':
        rules.append(PatternRule('perl.scalar', r'\$/'))

    if forbidden == ')':
        return rules + [PatternRule('data', r"[^$\%@\(\)]+")]
    elif forbidden == '}':
        return rules + [PatternRule('data', r"[^$\%@{}]+")]
    elif forbidden == ']':
        return rules + [PatternRule('data', r"[^$\%@\[\]]+")]
    elif forbidden == '>':
        return rules + [PatternRule('data', r"[^$\%@<>]+")]
    else:
        return rules

class DataGrammar(Grammar):
    rules = [PatternRule('data', '.+')]

class QuotedWords(Grammar):
    rules = [PatternRule('data', hword), eol, spaces]

class StrictStringGrammar(Grammar):
    rules = [
        PatternRule('escaped', r"\\[\\']"),
        PatternRule('data', r"[^\\']+"),
    ]
class StringGrammar(Grammar):
    rules = _make_string_rules('"') + [PatternRule('data', r'[^$%@\\"]+')]
class EvalGrammar(Grammar):
    rules = _make_string_rules('`') + [PatternRule('data', r'[^$%@\\`]+')]

class TranslateGrammar1(Grammar): rules = [PatternRule('data', r"(?:\\.|[^\\/])")]
class TranslateGrammar2(Grammar): rules = [PatternRule('data', r"(?:\\.|[^\\#])")]
class TranslateGrammar3(Grammar): rules = [PatternRule('data', r"(?:\\.|[^\\\)])")]
class TranslateGrammar4(Grammar): rules = [PatternRule('data', r"(?:\\.|[^\\\]])")]
class TranslateGrammar5(Grammar): rules = [PatternRule('data', r"(?:\\.|[^\\}])")]
class TranslateGrammar6(Grammar): rules = [PatternRule('data', r"(?:\\.|[^\\>])")]
class TranslateGrammarX(Grammar): rules = [PatternRule('data', r"(?:\\.|[^\\%(delim)s])")]

class MatchGrammar0(Grammar): rules = _make_string_rules(None)
class MatchGrammar1(Grammar): rules = _make_string_rules('/')
class MatchGrammar2(Grammar): rules = _make_string_rules('#')
class MatchGrammar3(Grammar): rules = _make_string_rules(')')
class MatchGrammar4(Grammar): rules = _make_string_rules(']')
class MatchGrammar5(Grammar): rules = _make_string_rules('}')
class MatchGrammar6(Grammar): rules = _make_string_rules('>')

PerlGrammar.rules = [
    RegionRule('perl.heredoc', r"<<(?P<heredoc>" + word1 + ")", None,
               r';\n', StringGrammar, r'^%(heredoc)s$'),
    RegionRule('perl.heredoc', r'<< *"(?P<heredoc>[^"]+)"', None,
               r';\n', StringGrammar, r'^%(heredoc)s$'),
    RegionRule('perl.heredoc', r"<< *'(?P<heredoc>[^']+)'", None,
               r";\n", DataGrammar, r'^%(heredoc)s$'),
    RegionRule('perl.evaldoc', r"<< *`(?P<heredoc>[^`]+)`", None,
               r";\n", StringGrammar, r'^%(heredoc)s$'),

    RegionRule('perl.endblock', "^__END__|__DATA__ *$", DataGrammar, ''),
    RegionRule('perl.pod', '^=' + word1, PodGrammar, '^=cut'),

    OverridePatternRule('perl.comment', '#@@:(?P<token>' + pname +
                        '):(?P<mode>' + pname + ') *$'),

    PatternMatchRule('x', '(sub)( +)(' + word2 +
                     r')( *)(\()( *)([\[\]\\@$%&*;]+)( *)(\))',
                     'perl.keyword', 'spaces', 'perl.sub', 'spaces',
                     'delimiter', 'spaces', 'perl.prototype', 'spaces',
                     'delimiter'),

    PatternRule('perl.comment', '#.*$'),
    RegionRule('perl.string', '"', StringGrammar, '"'),
    RegionRule('perl.string', "'", StrictStringGrammar, "'"),
    RegionRule('perl.evalstring', "`", EvalGrammar, "`"),
    PatternRule('perl.keyword', "(?<!->)(?:while|use|until|unless|undef|sub|return|require|package|our|no|next|my|last|if|foreach|for|eval|elsif|else|do|continue)(?![a-zA-Z0-9_])"),
    PatternRule('perl.reserved', "(?<!->)(?:STDIN|STDERR|STDOUT|__PACKAGE__)(?![a-zA-Z0-9_])"),
    PatternRule('perl.hashkey', '(?<={)' + wchr2 + '+(?=})'),
    PatternRule('perl.method', '(?<=->)' + word1),
    PatternRule('perl.hashkey', wchr2 + '+(?= *=>)'),
    PatternRule('perl.length', r"\$#" + word2),

    PatternRule('perl.number', r'0[xX][0-9A-Fa-f]+'),
    PatternRule('perl.number', r'-?0?\.[0-9]+|-?[0-9]+(?:\.[0-9]+)?'),

    PatternRule('perl.function', r"\$\$*" + word2 + "(?=-> *\()"),

    # special scalar; doesn't interpolate well
    PatternRule('perl.scalar', r'\$/'),
] + scalar_rules + [

    # match regexes; paired delimiters
    RegionRule('perl.match', r'm *(?P<delim>\()',
               MatchGrammar3, r'\)[a-z]*'),
    RegionRule('perl.match', r'm *(?P<delim>\[)',
               MatchGrammar4, r'\][a-z]*'),
    RegionRule('perl.match', r'm *(?P<delim>\{)',
               MatchGrammar5, r'\}[a-z]*'),
    RegionRule('perl.match', r'm *(?P<delim>\<)',
               MatchGrammar6, r'\>[a-z]*'),

    # match regexes; standard delimiters
    RegionRule('perl.match', r'(?:(?<==~)|(?<=!~)|(?<=\()|(?<=split)|(?<=if)|(?<=unless)|(?<=while)|(?<=until)|(?<=\|\|)|(?<=&&)|(?<==)) *(?P<delim>/)', MatchGrammar1, '/[a-z]*'),
    RegionRule('perl.match', 'm *(?P<delim>/)', MatchGrammar1, '/[a-z]*'),
    RegionRule('perl.match', 'm *(?P<delim>[^ #a-zA-Z0-9_])',
               MatchGrammar0, '%(delim)s[a-z]*'),
    RegionRule('perl.match', 'm(?P<delim>#)', MatchGrammar2, '#[a-z]*'),

    # replace regexes; paired delimiters
    RegionRule('perl.replace', r's *(?P<delim>\()', MatchGrammar3,
               r'\)', WhitespaceGrammar, '\(', MatchGrammar3, r'\)[a-z]*'),
    RegionRule('perl.replace', r's *(?P<delim>\[)', MatchGrammar4,
               r'\]', WhitespaceGrammar, '\[', MatchGrammar4, r'\][a-z]*'),
    RegionRule('perl.replace', r's *(?P<delim>\{)', MatchGrammar5,
               r'\}', WhitespaceGrammar, '\{', MatchGrammar5, r'\}[a-z]*'),
    RegionRule('perl.replace', r's *(?P<delim>\<)', MatchGrammar6,
               r'\>', WhitespaceGrammar, '\<', MatchGrammar6, r'\>[a-z]*'),

    # replace regexes; standard delimiters
    RegionRule('perl.replace', 's(?P<delim>#)',
               MatchGrammar2, '#', MatchGrammar2, '#[a-z]*'),
    RegionRule('perl.replace', 's *(?P<delim>/)',
               MatchGrammar1, '/', MatchGrammar1, '/[a-z]*'),
    RegionRule('perl.replace', 's *(?P<delim>[^ a-zA-Z0-9_])',
               MatchGrammar0, '%(delim)s',
               MatchGrammar0, '%(delim)s[a-z]*'),

    # translate operator; paired delimiters #XYZ
    RegionRule('perl.translate', r'(?:y|tr) *(?P<delim>\()', TranslateGrammar3,
               r'\)', WhitespaceGrammar, '\(', TranslateGrammar3, r'\)[a-z]*'),
    RegionRule('perl.translate', r'(?:y|tr) *(?P<delim>\[)', TranslateGrammar4,
               r'\]', WhitespaceGrammar, '\[', TranslateGrammar4, r'\][a-z]*'),
    RegionRule('perl.translate', r'(?:y|tr) *(?P<delim>\{)', TranslateGrammar5,
               r'\}', WhitespaceGrammar, '\{', TranslateGrammar5, r'\}[a-z]*'),
    RegionRule('perl.translate', r'(?:y|tr) *(?P<delim>\<)', TranslateGrammar6,
               r'\>', WhitespaceGrammar, '\<', TranslateGrammar6, r'\>[a-z]*'),

    # translate operator
    RegionRule('perl.translate', '(?:y|tr) *(?P<delim>/)',
               TranslateGrammar1, '/', TranslateGrammar1, '/[a-z]*'),
    RegionRule('perl.translate', '(?:y|tr)#', TranslateGrammar2,
               '#', TranslateGrammar2, '#[a-z]*'),
    RegionRule('perl.translate', '(?:y|tr) *(?P<delim>[^ a-zA-Z0-9_])',
               TranslateGrammarX, '%(delim)s', TranslateGrammarX,
               '%(delim)s[a-z]*'),

    # some more basic stuff
    PatternRule('perl.package', "(?<=package )" + word2),
    PatternRule('perl.sub', "(?<=sub )" + word2),
    PatternRule('perl.use', "(?<=use )" + word2),
    PatternRule('perl.use', "(?<=no )" + word2),
    PatternRule('perl.require', "(?<=require )" + word2),
    PatternRule('perl.label', word1 + ':(?!:)'),
    PatternRule('perl.function', r'&(?= *{)'),
    PatternRule('perl.function', r"&\$*" + word2),
    PatternRule('perl.builtin', "(?<!->)&?(?:write|warn|wantarray|waitpid|wait|vec|values|utime|use|untie|unshift|unpack|unlink|undef|umask|ucfirst|uc|truncate|times|time|tied|tie|telldir|tell|syswrite|system|sysseek|sysread|sysopen|syscall|symlink|substr|sub|study|stat|srand|sqrt|sprintf|split|splice|sort|socketpair|socket|sleep|sin|shutdown|shmwrite|shmread|shmget|shmctl|shift|setsockopt|setservent|setpwent|setprotoent|setpriority|setpgrp|setnetent|sethostent|setgrent|send|semop|semget|semctl|select|seekdir|seek|scalar|rmdir|rindex|rewinddir|reverse|return|reset|require|rename|ref|redo|recv|readpipe|readlink|readline|readdir|read|rand|quotemeta|push|prototype|printf|print|pos|pop|pipe|package|pack|our|ord|opendir|open|oct|no|next|my|msgsnd|msgrcv|msgget|msgctl|mkdir|map|lstat|log|lock|localtime|local|listen|link|length|lcfirst|lc|last|kill|keys|join|ioctl|int|index|import|hex|grep|goto|gmtime|glob|getsockopt|getsockname|getservent|getservbyport|getservbyname|getpwuid|getpwnam|getpwent|getprotoent|getprotobynumber|getprotobyname|getpriority|getppid|getpgrp|getpeername|getnetent|getnetbyname|getnetbyaddr|getlogin|gethostent|gethostbyname|gethostbyaddr|getgrnam|getgrgid|getgrent|getc|formline|format|fork|flock|fileno|fcntl|exp|exit|exists|exec|eval|eof|endservent|endpwent|endprotoent|endnetent|endhostent|endgrent|each|dump|do|die|delete|defined|dbmopen|dbmclose|crypt|cos|continue|connect|closedir|close|chroot|chr|chown|chop|chomp|chmod|chdir|caller|bless|binmode|bind|atan2|alarm|accept|abs)(?![a-zA-Z0-9_])"),

    # quote operator: qq(), qx() and qr() usually interpolate
    RegionRule('perl.quoted', r'q[rqx] *(?P<delim>\()', MatchGrammar3, r'\)'),
    RegionRule('perl.quoted', r'q[rqx] *(?P<delim>\[)', MatchGrammar4, r'\]'),
    RegionRule('perl.quoted', 'q[rqx] *(?P<delim>{)', MatchGrammar5, '}'),
    RegionRule('perl.quoted', 'q[rqx] *(?P<delim><)', MatchGrammar6, '>'),
    RegionRule('perl.quoted', 'q[rqx](?P<delim>#)', MatchGrammar2, '#'),
    RegionRule('perl.quoted', 'q[rqx] *(?P<delim>/)', MatchGrammar1, '/'),
    RegionRule('perl.quoted', 'q[rqx] *(?P<delim>[^ a-zA-Z0-9#])', MatchGrammar0, '%(delim)s'),

    # quote operator: q() and qw() do not interpolate
    RegionRule('perl.quoted', r'qw? *\(', QuotedWords, r'\)'),
    RegionRule('perl.quoted', 'qw? *{', QuotedWords, '}'),
    RegionRule('perl.quoted', 'qw? *<', QuotedWords, '>'),
    RegionRule('perl.quoted', r'qw? *\[', QuotedWords, r'\]'),
    RegionRule('perl.quoted', 'qw?#', QuotedWords, '#'),
    RegionRule('perl.quoted', 'qw? *(?P<delim>[^ a-zA-Z0-9#])', QuotedWords, '%(delim)s'),

    PatternRule('perl.function', word2 + r"(?= *\()"),
    PatternRule('perl.class', word2 + "(?=->)"),

    PatternRule('perl.glob', r'\*(?= *{)'),
    PatternRule('perl.glob', r'(?:(?<=[^a-zA-Z0-9_])|(?<=^)) *\*\$*' + word2),

    # some basic stuff
    PatternRule('delimiter', r"::|->|=>|(?<!:):(?!=:)|[,;=\?(){}\[\]\(\)]"),
    PatternRule('perl.noperator', "-[rwxoRWXOezsfdlpSbctugkTBMAC](?!" +
                wchr2 + ")"),
    PatternRule('perl.operator', r"\+=|-=|\*=|/=|//=|%=|&=\|\^=|>>=|<<=|\*\*=|\\"),
    PatternRule('perl.operator', r"\+\+|\+|<=>|<>|<<|<=|<|-|>>|>=|>|\*\*|\*|&&|&|\|\||\||/|\^|==|//|~|=~|!~|!=|%|!|\.\.|\.|x(?![a-zA-Z_])"),
    PatternRule('perl.noperator', "(?:xor|or|not|ne|lt|le|gt|ge|eq|cmp|and)(?![a-zA-Z_])"),
    PatternRule('perl.function', word2 + r'(?= +[a-zA_Z0-9_$@%&*\\\'(){}\[\]\"])'),
    PatternRule('perl.bareword', word2),

    spaces,
    eol,
]

class PerlTabber(StackTabber2):
    is_ignored_tokens = ('spaces', 'eol', 'perl.comment')
    open_tokens       = {'delimiter': {'{': '}', '(': ')', '[': ']'}}
    close_tokens      = {'delimiter': {'}': '{', ')': '(', ']': '['}}
    end_at_eof        = False
    end_at_tokens     = {'delimiter': {';': 1}}
    nocontinue_tokens = {'delimiter': {';': 1, ',': 1, '}': 1},
                         'perl.heredoc.end': 1,
                         'perl.evaldoc.end': 1,
                         'perl.pod.end': 1}
    start_free_tokens  = {'perl.string.start': 1,
                          'perl.pod.start': 1,
                          'perl.heredoc.start': 1,
                          'perl.evaldoc.start': 1}
    end_free_tokens    = {'perl.string.end': 1,
                          'perl.pod.end': 1,
                          'perl.heredoc.end': 1,
                          'perl.evaldoc.end': 1}

class PerlSetLib(Method):
    '''Set the path(s) to find perl modules'''
    args = [arg("lib", dt='path', p="Lib: ", dv=lambda w: '.')]
    def _execute(self, w, **vargs):
        w.application.config['perl.libs'] = vargs['lib'].split(':')
class PerlAddLib(PerlSetLib):
    '''Set the path(s) to find perl modules'''
    def _execute(self, w, **vargs):
        w.application.config['perl.libs'].append(vargs['lib'])

class PerlBase(Method):
    bname = '*Perl*'
    def get_args(self, w, **vargs):
        return ['perl', '-e', 'print "hello world\n"']
    def run_pipe(self, w, args, switch, mname=None):
        return w.application.run_pipe(args, w.buffer, self.bname, switch, mname)

class PerlCheckSyntax(PerlBase):
    '''Check the syntax of a perl file'''
    bname = '*Perl-Syntax*'
    def get_args(self, w, **vargs):
        args = ['perl']
        for l in w.application.config.get('perl.libs', []):
            args.extend(('-I', l))
        return args + ['-c', '-']
    def _execute(self, w, **vargs):
        args = self.get_args(w, **vargs)
        r = self.run_pipe(w, args, lambda x: x != 0, 'error')
        b = w.application.get_buffer_by_name(self.bname)
        b.orig_path = w.buffer.path
        if r == 0: w.set_error("Syntax OK")

class PerldocModule(PerlBase):
    '''View documentation about this buffer using perldoc'''
    bname = '*Perldoc*'
    prog  = 'use Pod::Text; Pod::Text->new()->parse_from_filehandle();';
    def get_args(self, w, **vargs):
        return ('perl', '-e', self.prog)
    def _execute(self, w, **vargs):
        self.run_pipe(w, self.get_args(w, **vargs), True)

class Perldoc(Method):
    name_re = re.compile('(?:[a-zA-Z_][a-zA-Z0-9_]*::)*[a-zA-Z_][a-zA-Z0-9_]*')
    args    = [arg("name", p="Perldoc: ", q='perldoc')]
    def _execute(self, w, **vargs):
        name = vargs['name']
        if not self.name_re.match(name):
            w.set_error("name %r is invalid" % name)
            return

        # try it as a module first
        parts = name.split('::')
        while len(parts) > 0:
            newname = '::'.join(parts)
            data = self._try(w, newname, asfunc=False)
            if data:
                self._show(w, data, newname)
                return
            parts.pop(-1)

        # then try it as a function
        data = self._try(w, name, asfunc=True)
        if data:
            self._show(w, data, name)
        else:
            w.set_error('nothing found for %r' % name)
    def _try(self, w, name, asfunc=False):
        if asfunc:
            cmd = "perldoc -f '%s'" % name
        else:
            cmd = "perldoc '%s'" % name
        l = w.application.config.get('perl.libs', [])
        if l:
            cmd = 'PERL5LIB=%r %s' % (':'.join(['%r' % x for x in l]), cmd)

        p      = Popen(cmd, shell=True, stdout=PIPE, stderr=PIPE)
        output = p.stdout.read()
        result = p.wait()
        status = os.WEXITSTATUS(result)
        if status == 0:
            xterm = term.XTerm(cbuf=True)
            output = xterm.term_filter(output)
            return output
        else:
            return None
    def _show(self, w, data, name):
        w.application.color_data_buffer("*Perldoc*", data, switch_to=True)
        w.set_error('displaying perldoc for %r' % name)

class PerldocF(Perldoc):
    def _execute(self, w, **vargs):
        name = vargs['name']
        if not self.name_re.match(name):
            w.set_error("name %r is invalid" % name)
            return

        # then try it as a function
        data = self._try(w, name, asfunc=True)
        if data:
            self._show(w, data, name)
        else:
            w.set_error('nothing found for %r' % name)

class PerldocWord(Perldoc):
    '''View documentation about a package or function using perldoc'''
    args = []
    def _execute(self, w, **vargs):
        word = w.get_token().string
        if word is None:
            w.set_error('no word selected')
            return
        return Perldoc._execute(self, w, name=word)

class PerlQuoteWord(Method):
    word_re = re.compile('^[a-zA-Z0-9_]+$')
    def _execute(self, w, **vargs):
        t = w.get_token()
        if t.fqname().endswith('string.data'):
            return w.set_error('word is already quoted')
        word = t.string
        if word is None:
            return w.set_error('no word selected')
        if not self.word_re.match(word):
            return w.set_error('not a perl word: %r' % word)

        w.insert_string(Point(t.x, t.y), "'")
        w.insert_string(Point(t.end_x(), t.y), "'")

class PerlDequoteWord(Method):
    word_re = re.compile('^[a-zA-Z0-9_]+$')
    def _execute(self, w, **vargs):
        p      = w.logical_cursor()
        tokens = w.get_token_list_at_point(p)
        token  = None
        seen   = False
        for t in tokens:
            if t.end_x() < p.x: 
                pass
            elif t.fqname().endswith('string.start'):
                seen = True
            elif t.fqname().endswith('string.data'):
                token = t
            elif token and t.fqname().endswith('string.end'):
                break
            elif seen:
                token = None
                break

        if not token:
            w.set_error('no suitable quoted word found!')
            return
        w.delete_char(Point(token.end_x(), token.y))
        w.delete_char(Point(token.x - 1, token.y))

class PerlInitFunctions(Method):
    '''Jump to a function defined in this module'''
    def _execute(self, w, **vargs):
        w.mode.context.build_name_map()
        w.set_error("Initialized function map")

class PerlGotoFunction(Method):
    '''Jump to a function defined in this module'''
    args = [Argument("name", type(""), "perlfunction", "Goto Function: ")]
    def _execute(self, w, **vargs):
        name = vargs['name']
        functions = w.mode.context.get_names()
        if name in functions:
            w.goto(Point(0, functions[name]))
        else:
            w.set_error("Function %r was not found" % name)

class PerlListFunctions(Method):
    '''Show the user all functions defined in this module'''
    def _execute(self, w, **vargs):
        names = w.mode.context.get_name_list()
        output = "\n".join(names) + "\n"
        w.application.data_buffer("*Perl-List-Functions*", output, switch_to=True)

class PerlWhichFunction(Method):
    '''Show the user what function they are in'''
    def _execute(self, w, **vargs):
        cursor = w.logical_cursor()
        name = w.mode.context.get_line_name(cursor.y)
        if name is None:
            w.set_error("None");
        else:
            functions = w.mode.context.get_names()
            i = functions[name] + 1
            w.set_error("line %d: %s" % (i, name))

class PerlHashCleanup(Method):
    '''Correctly align assignment blocks and literal hashes'''
    def _execute(self, w, **vargs):
        cursor = w.logical_cursor()
        b = w.buffer

        # so this is where we will store the groups that we find
        groups_by_line = {}

        # the regex we will try
        regexes = [regex.perl_hash_cleanup,
                   regex.perl_assign_cleanup]

        # if we aren't in a hash, inform the user and exit
        line = b.lines[cursor.y]
        myregex = None
        for r in regexes:
            if r.match(line):
                myregex = r

        if myregex is None:
            raise Exception("Not a perl hash line")

        groups_by_line[cursor.y] = myregex.match(line).groups()
        
        # find the beginning of this hash block
        start = 0
        i = cursor.y - 1
        while i >= 0:
            line = b.lines[i]
            m = myregex.match(line)
            if not m:
                start = i + 1
                break
            else:
                groups_by_line[i] = m.groups()
            i -= 1

        # find the end of this hash block
        end = len(b.lines) - 1
        i = cursor.y + 1
        while i < len(b.lines):
            line = b.lines[i]
            m = myregex.match(line)
            if not m:
                end = i - 1
                break
            else:
                groups_by_line[i] = m.groups()
            i += 1
    
        # assume that the least indented line is correct
        indent_w = min([len(groups_by_line[k][0]) for k in groups_by_line])

        # find the longest hash key to base all the other padding on
        key_w = max([len(groups_by_line[k][1]) for k in groups_by_line])

        # for each line, format it correctly
        keys = groups_by_line.keys()
        keys.sort()
        data = ''
        for i in keys:
            indent_pad = ' ' * indent_w
            key = groups_by_line[i][1]
            sep = groups_by_line[i][3]
            value = groups_by_line[i][5]
            key_pad = ' ' * (key_w - len(key))
            data += indent_pad + key + key_pad + ' ' + sep + ' ' + value + '\n'

        # remove the old text and add the new
        start_p = Point(0, start)
        if end < len(w.buffer.lines) - 1:
            end_p = Point(0, end + 1)
        else:
            end_p = Point(len(w.buffer.lines[end]), end)
        w.delete(start_p, end_p)
        w.insert_string(start_p, data)

class PerlWrapParagraph(WrapParagraph):
    '''Wrap Comments and POD'''
    # enumerations for line types
    LT_COMMENT = 1
    LT_POD     = 2

    margin     = 80
    comment_re = re.compile('( *)(#+)( *)(.*)')

    def _detect_line_type(self, w, y):
        h = w.buffer.highlights[w.mode.name]
        ltype = None
        for t in h.tokens[y]:
            fqname = t.fqname()
            if fqname == 'spaces' or fqname == 'eol':
                pass
            elif fqname == 'perl.comment':
                return self.LT_COMMENT
            elif fqname.startswith('perl.pod'):
                return self.LT_POD
            else:
                return None
        return None

    def _fix_comments(self, c, w):
        y1 = c.y
        y2 = c.y
        while y2 < len(w.buffer.lines) - 1:
            if self._detect_line_type(w, y2 + 1):
                y2 += 1
            else:
                break
    
        lines = w.buffer.lines[y1:y2 + 1]
        m = self.comment_re.match(lines[0])
        assert m
        prepend = m.group(1) + m.group(2)
        rmargin = self.margin - len(prepend) - 1
        dpad    = m.group(3)

        segments = []
        for line in lines:
            m = self.comment_re.match(line)
            assert m
            pad, data = m.group(3), m.group(4)
            if segments and pad == dpad and segments[-1][0] == dpad and segments[-1][1]:
                data = segments.pop(-1)[1] + ' ' + data
            i = 0
            while len(pad) + len(data[i:]) > rmargin:
                while data[i] == ' ':
                    i += 1
                j = rmargin - len(pad)
                while j >= 0 and data[i + j] != ' ':
                    j -= 1
                if j < 0:
                    j = rmargin - len(pad)
                segments.append([pad, data[i:i + j]])
                i += j
            if data:
                while data[i] == ' ':
                    i += 1
                segments.append([pad, data[i:]])
            else:
                segments.append(['', ''])

        lines2 = [prepend + x[0] + x[1] for x in segments]
        p1 = Point(0, y1)
        p2 = Point(len(w.buffer.lines[y2]), y2)
        w.buffer.delete(p1, p2)
        w.buffer.insert_lines(p1, lines2)
        w.set_error("wrapped comment lines %d-%d" % (y1 + 1, y2 + 1))

    def _execute(self, w, **vargs):
        c = w.logical_cursor()
        ltype = self._detect_line_type(w, c.y)
        if ltype == self.LT_COMMENT:
            self._fix_comments(c, w)
        elif ltype == self.LT_POD:
            WrapParagraph._execute(self, w, **vargs)
        else:
            w.set_error("did not detect comment or pod lines")

class PerlSemanticComplete(TokenComplete):
    _mini_prompt = 'Semantic Complete'
    def _min_completion(self, w, x1, x2, y):
        a = w.application
        a.methods['iperl-path-start'].execute(w, switch=False)

        name = IperlBuffer.create_name(w.buffer)
        b = a.get_buffer_by_name(name)

        line = w.buffer.lines[y]
        candidates = b.readline_completions(x1, x2, line)
        if not candidates:
            return ([], line[x1:x2])

        i = 0
        while i < len(candidates[0]):
            for s in candidates:
                if len(s) <= i or s[i] != candidates[0][i]:
                    break
            i += 1
        return (candidates, candidates[0][:i])
    def _execute(self, w, **vargs):
        b = w.buffer
        x2, y = w.logical_cursor().xy()
        if y >= len(b.lines):
            return

        x1 = x2
        while x1 > 0 and b.lines[y][x1 - 1] in "$@%*&abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_:":
            x1 -= 1
        assert x1 >= 0, "%r %r %r" % (x1, x2, len(b.lines[y]))

        (candidates, result) = self._min_completion(w, x1, x2, y)

        if candidates:
            p1 = Point(x1, y)
            p2 = Point(x2, y)
            w.buffer.delete(p1, p2)
            w.insert_string(p1, result)

        if not candidates:
            w.set_error("No completion: %r" % result)
        elif len(candidates) == 1:
            w.set_error("Unique completion: %r" % result)
        elif result in candidates:
            w.set_error("Ambiguous completion: %r" % candidates)
        else:
            w.set_error("Partial completion: %r" % candidates)

class PerlOpenModule(Method):
    args = [Argument("module", type=type(""), prompt="Open Perl Module: ")]
    def _execute(self, w, **vargs):
        path = w.mode.find_module(vargs['module'])
        if path:
            w.application.methods['open-file'].execute(w, filename=path)
        else:
            w.set_error("Could not find module %r" % vargs['module'])

class PerlOpenModuleWord(Method):
    namechars = string.ascii_letters + string.digits + '_'
    def _execute(self, w, **vargs):
        word = pkg = w.get_token().string
        path = None
        while pkg and pkg[0] not in self.namechars:
            pkg = pkg[1:]
        while True:
            path = w.mode.find_module(pkg)
            if path:
                break
            parent = pkg.rsplit('::', 1)[0]
            if parent == pkg:
                break
            else:
                pkg = parent
        if path:
            w.application.methods['open-file'].execute(w, filename=path)
        else:
            w.set_error("Could not find module related to %r" % word)

class PerlFunctionCompleter(completer.Completer):
    def get_candidates(self, s, w=None):
        old_window = w.buffer.method.old_window
        functions = old_window.mode.context.get_names()
        return [n for n in functions if n.startswith(s)]

class PerlContext(context.Context):
    sub_match = And(Optional(Name('spaces')), 
                    Match('perl.keyword', 'sub'),
                    Name('spaces'),
                    Name('perl.sub'))
    def _regen_stack(self, y):
        if y > 0 and self.namelines[y - 1][1]:
            return list(self.namelines[y - 1][1])
        else:
            return []

    def _build_name_map(self, y1, y2, last, curr, stack):
        tokenlines = self.mode.window.get_highlighter().tokens

        i = y1
        while i < y2:
            tokens = tokenlines[i]
            if not stack:
                result = self.sub_match.match(tokens)
                if result: curr = tokens[result[0] - 1].string

            if curr is not None: self.names.setdefault(curr, i)

            for t in tokens:
                if t.match('delimiter', '{'):
                    stack.append(curr)
                elif t.match('delimiter', '}'):
                    if stack: stack.pop(-1)
                    if not stack: curr = None

            if curr: self.namelines[i] = (curr, tuple(stack))
            i += 1

# white is for delimiters, operators, numbers
c_default = ('default', 'default')

# magenta is for keywords/builtins, translation, globs
lo_magenta = ('magenta202', 'default')
hi_magenta = ('magenta505', 'default')

# red is for comments, pods, endblocks
lo_red = ('red300', 'default')
hi_red = ('red511', 'default')

# orange are for arrays and hashes
hi_orange = ('yellow531', 'default')
lo_orange = ('yellow520', 'default')

# yellow is for scalars and prototypes
hi_yellow = ('yellow551', 'default')
lo_yellow = ('yellow330', 'default')

# green is for strings and hash keys
lo_green = ('green030', 'default')
hi_green = ('green050', 'default')

# cyan is for quotes, evals, regexes, subs
lo_cyan = ('cyan033', 'default')
hi_cyan = ('cyan155', 'default')

# blue is unused
lo_blue = ('blue113', 'default')
hi_blue = ('blue225', 'default')

class Perl(Fundamental):
    name        = 'Perl'
    extensions  = ['.pl', '.pm', '.pod', '.t']
    detection   = [re.compile('^#!(?:.+/)?perl')]
    tabbercls   = PerlTabber
    grammar     = PerlGrammar
    commentc    = '#'
    opentokens  = ('delimiter',)
    opentags    = {'(': ')', '[': ']', '{': '}'}
    closetokens = ('delimiter',)
    closetags   = {')': '(', ']': '[', '}': '{'}
    colors      = {
        # comments
        'perl.comment': hi_red,

        # pod
        'pod.start':       hi_red,
        'pod.end':         hi_red,
        'pod.data':        hi_red,
        'pod.null':        hi_red,
        'pod.entry.start': hi_magenta,
        'pod.entry.end':   hi_magenta,
        'pod.entry.data':  hi_magenta,
        'pod.entry.null':  hi_magenta,
        
        # basic stuff
        'perl.glob':      hi_magenta,
        'perl.noperator': hi_magenta,
        'perl.keyword':   hi_magenta,
        'perl.builtin':   hi_magenta,
        'perl.reserved':  hi_magenta,
        'perl.prototype': hi_yellow,
        'perl.scalar':    hi_yellow,
        'perl.length':    hi_yellow,
        'perl.deref':     hi_yellow,
        'perl.array':     hi_orange,
        'perl.hash':      lo_orange,
        'perl.hashkey':   hi_green,
        'perl.sub':       hi_cyan,
        'perl.method':    hi_cyan,
        'perl.function':  hi_cyan,
        'perl.label':     hi_cyan,
        'perl.package':   hi_blue,
        'perl.class':     hi_blue,
        'perl.use':       hi_blue,
        'perl.require':   hi_blue,

        # end/data block
        'endblock.start': hi_red,
        'endblock.end':   hi_red,
        'endblock.data':  hi_red,
        'endblock.null':  hi_red,

        # heredoc
        'heredoc.start': lo_green,
        'heredoc.end':   lo_green,
        'heredoc.data':  hi_green,
        'heredoc.null':  hi_green,

        # evaldoc
        'evaldoc.start': lo_cyan,
        'evaldoc.end':   lo_cyan,
        'evaldoc.data':  hi_cyan,
        'evaldoc.null':  hi_cyan,

        # numbers
        'perl.number': c_default,
        
        # strings
        'perl.string.start': lo_green,
        'perl.string.end':   lo_green,
        'perl.string.data':  hi_green,
        'perl.string.null':  hi_green,
        
        # `` strings
        'evalstring.start': lo_cyan,
        'evalstring.end':   lo_cyan,
        'evalstring.data':  hi_cyan,
        'evalstring.null':  hi_cyan,
        
        # quoted region
        'perl.quoted.start': lo_cyan,
        'perl.quoted.end':   lo_cyan,
        'perl.quoted.data':  hi_cyan,
        'perl.quoted.null':  hi_cyan,
        
        # match regex
        'match.start': lo_cyan,
        'match.end':   lo_cyan,
        'match.data':  hi_cyan,
        'match.null':  hi_cyan,
        
        # replace regex
        'replace.start':   lo_cyan,
        'replace.middle0': lo_cyan,
        'replace.middle1': lo_cyan,
        'replace.end':     lo_cyan,
        'replace.data':    hi_cyan,
        'replace.null':    hi_cyan,
        
        # translate regex
        'translate.start':   lo_magenta,
        'translate.middle0': lo_magenta,
        'translate.middle1': lo_magenta,
        'translate.end':     lo_magenta,
        'translate.data':    hi_magenta,
        'translate.null':    hi_magenta,
    }
    config  = {}
    lconfig = {'perl.libs': []}
    actions = [
        PerlSetLib, PerlCheckSyntax, PerlHashCleanup, PerldocModule,
        PerldocWord, Perldoc, PerldocF, PerlWrapParagraph, PerlInitFunctions,
        PerlGotoFunction, PerlWhichFunction, PerlListFunctions, PerlOpenModule,
        PerlOpenModuleWord, PerlSemanticComplete,
        PerlQuoteWord, PerlDequoteWord,
    ]
    completers = {
        'perlfunction': PerlFunctionCompleter(None),
    }
    format = "%(flag)s  %(bname)-18s  (%(mname)s)  %(indent)s  %(cursor)s  %(perc)s  [%(func)s]  %(vc-info)s"
    _bindings = {
        'perl-check-syntax':      ('C-c s',),
        'perl-goto-function':     ('C-c M-g',),
        'perl-hash-cleanup':      ('C-c h',),
        'perl-open-module':       ('C-c C-f',),
        'perl-open-module-word':  ('C-c M-f',),
        'perl-semantic-complete': ('C-c TAB',),
        'perl-set-lib':           ('C-c l',),
        'perl-wrap-paragraph':    ('M-q',),
        'perldoc-module':         ('C-c v',),
        'perldoc-word':           ('C-c p',),
        'close-paren':            (')'),
        'close-bracket':          (']'),
        'close-brace':            ('}'),
        'perl-quote-word':        ("C-c '",),
        'perl-dequote-word':      ("C-u '",),
    }
    def __init__(self, w):
        Fundamental.__init__(self, w)
        self.context   = PerlContext(self)
        self.functions = None
        self.funclines = None
        self.perlinc   = None

    def find_module(self, module):
        parts = module.split('::')
        parts[-1] += '.pm'
        relpath = os.path.join(*parts)
        path    = None
        for d in self.get_inc():
            path2 = os.path.join(d, relpath)
            if os.path.exists(path2):
                path = path2
                break
        return path

    def get_inc(self):
        a = self.window.application
        if self.perlinc is None:
            cmd = "perl -e 'print join(\"\\n\", @INC);'"
            if a.config.get('perl.libs', None):
                s = ':'.join(['%s' % x for x in a.config.get('perl.libs')])
                cmd = 'PERL5LIB=%r %s' % (s, cmd)

            p      = Popen(cmd, shell=True, stdout=PIPE, stderr=PIPE)
            data   = p.stdout.read()
            status = p.wait()

            if status != 0: raise Exception("%r failed" % cmd)
            self.perlinc = data.split('\n')
        return self.perlinc

    def get_functions(self):
        return self.context.get_names()
    def get_function_names(self):
        return self.context.get_name_list()
    def get_line_function(self, y):
        return self.context.get_line_name(y)
    def get_status_names(self):
        names = Fundamental.get_status_names(self)
        c = self.window.logical_cursor()
        names['func'] = self.get_line_function(c.y)
        return names

install = Perl.install