pmacs3/mode/perl.py

import os, re, string, sys
import buffer, color, commands, completer, context, default, method, mode, regex, tab
from point import Point
from lex import Grammar, PatternRule, ContextPatternRule, RegionRule, \
    OverridePatternRule, PatternGroupRule
from method import Argument, Method, WrapParagraph
from tab import StackTabber, StackTabber2

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

def _make_string_rules(forbidden):
    #rule1 = PatternRule(r'scalar', r"\$[^\[\]\(\){}<>A-Za-z0-9 \\%s](?![A-Za-z0-9_])" % forbidden)
    #rule2 = PatternRule(r'data', r"[^%s\\\@\$%%\&]+" % forbidden)

    rules = [
        PatternRule(r'octal', r'\\[0-7]{3}'),
        PatternRule(r'escaped', r'\\.'),
        PatternRule(r'deref', r"\$+[A-Za-z0-9_](?:[A-Za-z0-9_]|::)*(?:(?:->)?{\$?(?:[a-zA-Z_][a-zA-Z_0-9]*|'(?:\\.|[^'\\])*'|\"(\\.|[^\\\"])*\")}|(?:->)?\[\$?[0-9a-zA-Z_]+\])+"),
        PatternRule(r'length', r"\$#[A-Za-z0-9_](?:[A-Za-z0-9_]|::)*"),
        #rule1,
        PatternRule(r'scalar', r"\$\$*[A-Za-z0-9_](?:[A-Za-z0-9_]|::)*"),
        PatternRule(r'cast', r"[\$\@\%\&]{.*?}"),
        PatternRule(r'array', r"@\$*[A-Za-z_](?:[A-Za-z0-9_]|::)*"),
        #rule2,
    ]
    return rules

class StrictStringGrammar(Grammar):
    rules = [
        PatternRule(r'escaped', r"\\'"),
    ]
class StringGrammar(Grammar):
    rules = _make_string_rules('"')

class EvalGrammar(Grammar):
    rules = _make_string_rules('`')

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

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('>')

class QuotedGrammar1(Grammar):
    rules = _make_string_rules(')')
class QuotedGrammar2(Grammar):
    rules = _make_string_rules('}')
class QuotedGrammar3(Grammar):
    rules = _make_string_rules('>')
class QuotedGrammar4(Grammar):
    rules = _make_string_rules(']')

class PerlGrammar(Grammar):
    rules = [
        RegionRule(r'heredoc', r"<<(?P<heredoc>[a-zA-Z_][a-zA-Z0-9_]+)", None, ';\n', StringGrammar, r'^%(heredoc)s$'),
        RegionRule(r'heredoc', r'<< *"(?P<heredoc>[a-zA-Z0-9_]+)" *;', StringGrammar, r'^%(heredoc)s$'),
        RegionRule(r'heredoc', r"<< *'(?P<heredoc>[a-zA-Z0-9_]+)' *;", Grammar, r'^%(heredoc)s$'),
        RegionRule(r'evaldoc', r"<< *`(?P<heredoc>[a-zA-Z0-9_]+)` *;", StringGrammar, r'^%(heredoc)s$'),

        RegionRule(r'endblock', r"^__END__|__DATA__ *$", Grammar, r''),
        RegionRule(r'pod', r'^=[a-zA-Z0-9_]+', PodGrammar, r'^=cut'),

        OverridePatternRule(r'comment', r'#@@:(?P<token>[.a-zA-Z0-9_]+):(?P<mode>[.a-zA-Z0-9_]+) *$'),

        #PatternRule(r'prototype', r'\([\\@$%&*;]+\)'),
        PatternGroupRule(r'prototype', r'delimiter', r'\(', r'prototype', r'[\[\]\\@$%&*;]+', r'delimiter', '\)'),

        PatternRule(r'comment', r'#.*$'),
        RegionRule(r'perl_string', r'"', StringGrammar, r'"'),
        RegionRule(r'perl_string', r"'", StrictStringGrammar, r"'"),
        RegionRule(r'evalstring', r"`", EvalGrammar, r"`"),
        PatternRule(r'number', r'0?\.[0-9]+|[0-9]+(?:\.[0-9]+)?'),
        PatternRule(r'perl_keyword', r"(?<!->)(?:STDIN|STDERR|STDOUT|continue|do|else|elsif|eval|foreach|for|if|last|my|next|our|package|require|return|sub|undef|unless|until|use|while)(?![a-zA-Z0-9_])"),
        PatternRule(r'hash_key', r'(?<={)[A-Za-z0-9_]+(?=})'),
        PatternRule(r'hash_key', r'[A-Za-z0-9_]+(?= *=>)'),
        PatternRule(r'length', r"\$#[A-Za-z0-9_](?:[A-Za-z0-9_]|::)*"),
        PatternRule(r'cast', r'[\$\@\%\^\&](?= *{)'),
        PatternRule(r'scalar', r"\$[\[\]<>ab/'\"_@\?#\$!%^|&*()](?![A-Za-z0-9_])"),
        PatternRule(r'array', r"@_"),
        PatternRule(r'perl_function', r"\$\$*[A-Za-z0-9_](?:[A-Za-z0-9_]|::)*(?=-> *\()"),
        PatternRule(r'scalar', r"\$\$*[A-Za-z0-9_](?:[A-Za-z0-9_]|::)*"),
        PatternRule(r'array', r"@\$*[A-Za-z_](?:[A-Za-z0-9_]|::)*"),
        PatternRule(r'perl_hash', r"%\$*[A-Za-z_](?:[A-Za-z0-9_]|::)*"),
        PatternRule(r'deref', r"[@%\$&\*](?={)"),

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

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

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

        # replace regexes
        RegionRule(r'replace', r's *(?P<delim>/)', MatchGrammar1, r'/', MatchGrammar1, r'/[a-z]*'),
        RegionRule(r'replace', r's *(?P<delim>[^ a-zA-Z0-9_])', StringGrammar, r'%(delim)s', StringGrammar, r'%(delim)s[a-z]*'),
        RegionRule(r'replace', r's(?P<delim>#)', MatchGrammar2, r'#', MatchGrammar2, r'#[a-z]*'),

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

        # some more basic stuff
        PatternRule(r'package', r"(?<=package )(?:[a-zA-Z_][a-zA-Z_0-9]*::)*[a-zA-Z_][a-zA-Z_0-9]*"),
        PatternRule(r'sub', r"(?<=sub )(?:[a-zA-Z_][a-zA-Z_0-9]*::)*[a-zA-Z_][a-zA-Z_0-9]*"),
        PatternRule(r'use', r"(?<=use )(?:[a-zA-Z_][a-zA-Z_0-9]*::)*[a-zA-Z_][a-zA-Z_0-9]*"),
        PatternRule(r'require', r"(?<=require )(?:[a-zA-Z_][a-zA-Z_0-9]*::)*[a-zA-Z_][a-zA-Z_0-9]*"),
        PatternRule(r'perl_label', r'[a-zA-Z_][a-zA-Z0-9_]*:(?!:)'),
        PatternRule(r'method', r"(?<=->)[a-zA-Z_][a-zA-Z_0-9]*"),
        PatternRule(r'perl_function', r"&\$*(?:[a-zA-Z_][a-zA-Z_0-9]*::)*[a-zA-Z_][a-zA-Z_0-9]*"),
        PatternRule(r'perl_builtin', r"(?<!->)&?(?: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(r'quoted', r'q[rqx] *(?P<delim>\()', QuotedGrammar1, r'\)'),
        RegionRule(r'quoted', r'q[rqx] *(?P<delim>{)', QuotedGrammar2, r'}'),
        RegionRule(r'quoted', r'q[rqx] *(?P<delim><)', QuotedGrammar3, r'>'),
        RegionRule(r'quoted', r'q[rqx] *(?P<delim>\[)', QuotedGrammar4, r'\]'),
        RegionRule(r'quoted', r"q[rqx] *(?P<delim>')", Grammar, r"'"),
        RegionRule(r'quoted', r'q[rqx] *(?P<delim>[^ #])', StringGrammar, r'%(delim)s'),
        RegionRule(r'quoted', r'q[rqx](?P<delim>#)', StringGrammar, r'#'),

        # quote operator: q() and qw() do not interpolate
        RegionRule(r'quoted', r'qw? *\(', Grammar, r'\)'),
        RegionRule(r'quoted', r'qw? *{', Grammar, r'}'),
        RegionRule(r'quoted', r'qw? *<', Grammar, r'>'),
        RegionRule(r'quoted', r'qw? *\[', Grammar, r'\]'),
        RegionRule(r'quoted', r'qw?#', Grammar, r'#'),
        RegionRule(r'quoted', r'qw? *(?P<delim>[^ #])', Grammar, r'%(delim)s'),

        PatternRule(r'perl_function', r"(?:[a-zA-Z_][a-zA-Z_0-9]*::)*[a-zA-Z_][a-zA-Z_0-9]*(?= *\()"),
        PatternRule(r'perl_namespace', r"(?:[a-zA-Z_][a-zA-Z_0-9]*\:\:)+(?:[a-zA-Z_][a-zA-Z_0-9]*)?"),
        PatternRule(r'perl_class', r"(?:[a-zA-Z_][a-zA-Z_0-9]*::)*[a-zA-Z_][a-zA-Z_0-9]*(?=->)"),

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

        PatternRule(r'spaces', r' +'),
        PatternRule(r"eol", r"\n$"),
    ]

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

class PerlSetLib(Method):
    '''Set the path(s) to find perl modules'''
    args = [Argument("lib", type=type(""), prompt="Location of lib: ",
                            default=default.build_constant("."))]
    def _execute(self, w, **vargs):
        w.application.config['perl.lib'] = vargs['lib']
    
class PerlCheckSyntax(Method):
    '''Check the syntax of a perl file'''
    def _execute(self, w, **vargs):
        app = w.application
        perllib = w.application.config.get('perl.lib')
        if perllib:
            cmd = "perl -c -I '%s' '%s'" % (perllib, w.buffer.path)
        else:
            cmd = "perl -c '%s'" % (w.buffer.path)
        (status, output) = commands.getstatusoutput(cmd)
        if status == 0:
            app.set_error("Syntax OK")
            app.data_buffer("*Perl-Check-Syntax*", output, switch_to=False)
        else:
            app.data_buffer("*Perl-Check-Syntax*", output)

class PerlViewModulePerldoc(Method):
    '''View documentation about this file using perldoc'''
    def _execute(self, w, **vargs):
        cmd = "perldoc -t -T '%s'" % w.buffer.path
        (status, output) = commands.getstatusoutput(cmd)
        w.application.data_buffer("*Perldoc*", output, switch_to=True)

class PerlViewWordPerldoc(Method):
    '''View documentation about a package or function using perldoc'''
    def _try(self, w, word, asfunc=False):
        if asfunc:
            cmd = "perldoc -t -T -f '%s'" % (word,)
        else:
            cmd = "perldoc -t -T '%s'" % (word,)
        perllib = w.application.config.get('perl.lib')
        if perllib:
            cmd = 'PERL5LIB=%r %s' % (perllib, cmd)
        (status, data) = commands.getstatusoutput(cmd)
        if status == 0:
            return data
        else:
            return None
    def _show(self, w, data, word):
        w.application.data_buffer("*Perldoc*", data, switch_to=True)
        w.application.set_error('displaying documentation for %r' % word)
    def _execute(self, w, **vargs):
        token = w.get_token()
        word = token.string

        # make sure that the name is (mostly) valid
        if word is None:
            w.application.set_error('no word selected')
            return
        elif ':' in word and '::' not in word:
            w.application.set_error('invalid word: %r' % word)
            return

        # first try it is a package, unless it's a builtin
        if not token.name == "perl_builtin":
            parts = word.split('::')
            while len(parts) > 0:
                newword = '::'.join(parts)
                data = self._try(w, newword, asfunc=False)
                if data:
                    self._show(w, data, newword)
                    return
                parts.pop(-1)

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

class PerlInitFunctions(Method):
    '''Jump to a function defined in this module'''
    def _execute(self, w, **vargs):
        w.mode.context.build_name_map()
        w.application.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.application.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.application.set_error("None");
        else:
            functions = w.mode.context.get_names()
            i = functions[name] + 1
            w.application.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.kill(start_p, end_p)
        w.insert_string(start_p, data)

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

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

    def _is_newline(self, t):
        return t.name == 'eol'
    def _is_space(self, t):
        return t.name == 'spaces'

    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.startswith('comment'):
                if ltype and ltype != 'comment':
                    ltype = None
                    break
                ltype = self.LT_COMMENT
            elif fqname.startswith('pod'):
                if ltype and ltype != 'pod':
                    ltype = None
                    break
                ltype = self.LT_POD
            else:
                ltype = None
                break
        return ltype

    def _fix_comments(self, c, w):
        h = w.buffer.highlights[w.mode.name()]
        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)
        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 _fix_pod(self, c, w):
        w.set_error("pod wrapping not yet supported")

    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(method.introspect.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 = buffer.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.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.Method):
    namechars = string.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):
    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):
        blen       = len(self.mode.window.buffer.lines)
        highlights = self.mode.window.get_highlighter()
        i          = y1
        starting   = curr and not bool(stack)
        while i < y2:
            if not starting and not stack:
                curr = None

            g = highlights.tokens[i]
            if (not stack and len(g) > 2 and g[0].name == 'perl_keyword' and
                g[0].string == 'sub' and g[2].name == 'sub'):
                curr     = g[2].string
                starting = True

            if curr is not None and curr not in self.names:
                self.names[curr] = i

            if i == y2 - 1 and curr != self.namelines[i][0] and y2 < blen:
                y2 += 1

            m = self.mode
            for t in g:
                if t.name == 'delimiter' and t.string == '{':
                    stack.append(t.string)
                    starting = False
                elif t.name == 'delimiter' and t.string == '}':
                    if not stack:
                        # we are totally hosed. start over. ugh.
                        self.build_name_map()
                        return
                    stack.pop(-1)
            if curr:
                self.namelines[i] = (curr, tuple(stack))
            i += 1

class Perl(mode.Fundamental):
    modename    = 'Perl'
    extensions  = ['.pl', '.pm']
    detection   = ['perl']
    tabbercls   = PerlTabber2
    grammar     = PerlGrammar
    opentokens  = ('delimiter',)
    opentags    = {'(': ')', '[': ']', '{': '}'}
    closetokens = ('delimiter',)
    closetags   = {')': '(', ']': '[', '}': '{'}
    colors      = {
        # comments
        'endblock.start': ('red', 'default', 'bold'),
        'endblock.null':  ('red', 'default', 'bold'),
        'endblock.end':   ('red', 'default', 'bold'),

        # pod
        'pod.start':       ('red', 'default', 'bold'),
        'pod.null':        ('red', 'default', 'bold'),
        'pod.entry.start': ('magenta', 'default', 'bold'),
        'pod.entry.null':  ('magenta', 'default', 'bold'),
        'pod.entry.end':   ('magenta', 'default', 'bold'),
        'pod.end':         ('red', 'default', 'bold'),
        
        # basic stuff
        'escaped':        ('magenta', 'default', 'bold'),
        'null':           ('default', 'default', 'bold'),
        'sub':            ('cyan', 'default', 'bold'),
        'prototype':      ('yellow', 'default', 'bold'),
        'operator':       ('default', 'default', 'bold'),
        'noperator':      ('magenta', 'default', 'bold'),
        'endblock':       ('red', 'default', 'bold'),
        'perl_keyword':   ('magenta', 'default', 'bold'),
        'cast':           ('yellow', 'default', 'bold'),
        'scalar':         ('yellow', 'default', 'bold'),
        'array':          ('yellow', 'default', 'bold'),
        'deref':          ('yellow', 'default', 'bold'),
        'perl_hash':      ('yellow', 'default', 'bold'),
        'hash_key':       ('green', 'default', 'bold'),
        'perl_function':  ('cyan', 'default', 'bold'),
        'perl_namespace': ('cyan', 'default', 'bold'),
        'perl_builtin':   ('magenta', 'default', 'bold'),
        'perl_label':     ('cyan', 'default', 'bold'),
        'package':        ('cyan', 'default', 'bold'),
        'perl_class':     ('cyan', 'default', 'bold'),
        'use':            ('cyan', 'default', 'bold'),
        'require':        ('cyan', 'default', 'bold'),

        # heredoc/evaldoc
        'heredoc.start': ('green', 'default', 'bold'),
        'heredoc.null':  ('green', 'default', 'bold'),
        'heredoc.end':   ('green', 'default', 'bold'),
        'evaldoc.start': ('cyan', 'default', 'bold'),
        'evaldoc.null':  ('cyan', 'default', 'bold'),
        'evaldoc.end':   ('cyan', 'default', 'bold'),
        
        # strings
        'perl_string.start':   ('green', 'default', 'bold'),
        'perl_string.null':    ('green', 'default', 'bold'),
        'perl_string.escaped': ('magenta', 'default', 'bold'),
        'perl_string.deref':   ('yellow', 'default', 'bold'),
        'perl_string.end':     ('green', 'default', 'bold'),
        
        # `` strings
        'evalstring.start':   ('cyan', 'default', 'bold'),
        'evalstring.null':    ('cyan', 'default', 'bold'),
        'evalstring.escaped': ('magenta', 'default', 'bold'),
        'evalstring.deref':   ('yellow', 'default', 'bold'),
        'evalstring.end':     ('cyan', 'default', 'bold'),
        
        # quoted region
        'quoted':         ('cyan', 'default', 'bold'),
        'quoted.start':   ('cyan', 'default', 'bold'),
        'quoted.null':    ('cyan', 'default', 'bold'),
        'quoted.escaped': ('magenta', 'default', 'bold'),
        'quoted.deref':   ('yellow', 'default', 'bold'),
        'quoted.end':     ('cyan', 'default', 'bold'),
        
        # match regex
        'match.start': ('cyan', 'default', 'bold'),
        'match.end':   ('cyan', 'default', 'bold'),
        'match.null':  ('cyan', 'default', 'bold'),
        
        # replace regex
        'replace.start':     ('cyan', 'default', 'bold'),
        'replace.middle0':   ('cyan', 'default', 'bold'),
        'replace.end':       ('cyan', 'default', 'bold'),
        'replace.null':      ('cyan', 'default', 'bold'),
        'replace.escaped':   ('magenta', 'default', 'bold'),
        'replace.deref':     ('yellow', 'default', 'bold'),
        'replace.length':    ('yellow', 'default', 'bold'),
        'replace.scalar':    ('yellow', 'default', 'bold'),
        'replace.perl_hash': ('yellow', 'default', 'bold'),
        'replace.cast':      ('yellow', 'default', 'bold'),
        
        # translate regex
        'translate.start':   ('magenta', 'default', 'bold'),
        'translate.middle0': ('magenta', 'default', 'bold'),
        'translate.end':     ('magenta', 'default', 'bold'),
        'translate.null':    ('magenta', 'default', 'bold'),
    }
    config = {
        'perl.lib': 'lib',
    }
    actions = [PerlSetLib, PerlCheckSyntax, PerlHashCleanup,
               PerlViewModulePerldoc, PerlViewWordPerldoc, PerlWrapParagraph,
               PerlInitFunctions, PerlGotoFunction, PerlWhichFunction,
               PerlListFunctions, PerlOpenModule, PerlOpenModuleWord,
               PerlSemanticComplete]
    completers = {
        'perlfunction': PerlFunctionCompleter(None),
    }
    format = "%(flag)s  %(bname)-18s  (%(mname)s)  %(indent)s  %(cursor)s/%(mark)s  %(perc)s  [%(func)s]"
    #format = "%(flag)s  %(bname)-18s  (%(mname)s)  %(cursor)s/%(mark)s  %(perc)s"
    def get_status_names(self):
        names = mode.Fundamental.get_status_names(self)
        c = self.window.logical_cursor()
        names['func'] = self.get_line_function(c.y)
        return names
    def __init__(self, w):
        mode.Fundamental.__init__(self, w)
        self.add_bindings('perl-set-lib', ('C-c l',))
        self.add_bindings('perl-check-syntax', ('C-c s',))
        self.add_bindings('perl-hash-cleanup', ('C-c h',))
        self.add_bindings('perl-view-module-perldoc', ('C-c v',))
        self.add_bindings('perl-view-word-perldoc', ('C-c p',))
        self.add_bindings('perl-wrap-paragraph', ('M-q',))
        self.add_bindings('perl-goto-function', ('C-c M-g',))
        self.add_bindings('perl-open-module', ('C-c C-f',))
        self.add_bindings('perl-open-module-word', ('C-c M-f',))
        self.add_bindings('perl-semantic-complete', ('C-c TAB',))
        self.add_bindings('close-paren', (')'))
        self.add_bindings('close-bracket', (']'))
        self.add_bindings('close-brace', ('}'))
        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):
        if self.perlinc is None:
            perllib = a.config.get('perl.lib')
            if perllib:
                cmd = "PERL5LIB=%r perl -e 'print join(\"\\n\", @INC);'" % perllib
            else:
                cmd = "perl -e 'print join(\"\\n\", @INC);'"
            (status, data) = commands.getstatusoutput(cmd)
            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)

install = Perl.install