view release on metacpan or  search on metacpan

lib/App/Greple/md.pm  view on Meta::CPAN

            push @final_cm, "$label=$current$append";
        } else {
            push @final_cm, $expanded;
        }
    }

    $cm = Getopt::EX::Colormap->new(
        HASH => \%colors,
        NEWLABEL => 1,
    );
    $cm->load_params(@final_cm);
}

sub active {
    my $label = shift;
    return 0 if exists $show{$label} && !$show{$label};
    return 1 unless exists $cm->{HASH}{$label};
    $cm->{HASH}{$label} ne '';
}

#
# Apply color by label
#

sub md_color {
    my($label, $text) = @_;
    $cm->color($label, $text);
}

#
# Protection mechanism
#
# SGR 256 placeholders protect processed regions (inline code,
# comments, links) from being matched by later patterns.
#

my @protected;
my($PS, $PE) = ("\e[256m", "\e[m");     # protect start/end markers
my $PR = qr/\e\[256m(\d+)\e\[m/;       # protect restore pattern
my($OS, $OE) = ("\e]8;;", "\e\\");      # OSC 8 start/end markers

sub protect {
    my $text = shift;
    push @protected, $text;
    $PS . $#protected . $PE;
}

sub restore {
    my $s = shift;
    1 while $s =~ s{$PR}{$protected[$1] // die "restore failed: index $1"}ge;
    $s;
}

#
# OSC 8 hyperlink generation
#

sub osc8 {
    return $_[1] unless $config->{osc8};
    my($url, $text) = @_;
    my $escaped = uri_escape_utf8($url, "^\\x20-\\x7e");
    "${OS}${escaped}${OE}${text}${OS}${OE}";
}

#
# Link text inner pattern: backtick spans, backslash escapes, normal chars
#

my $LT = qr/(?:`[^`\n]*+`|\\.|[^`\\\n\]]++)+/;

#
# colorize() - the main function
#
# Receives entire file content in $_ (--begin with -G --filter).
# Processes all patterns with multiline regexes.
#

#
# Pipeline steps as code refs
#

my %colorize = (
    code_blocks => sub {
        s{^( {0,3})(`{3,}|~{3,})(.*)\n((?s:.*?))^( {0,3})\2(\h*)$}{
            my($oi, $fence, $lang, $body, $ci, $trail) = ($1, $2, $3, $4, $5, $6);
            my $result = md_color('code_mark', "$oi$fence");
            $result .= md_color('code_info', $lang) if length($lang);
            $result .= "\n";
            if (length($body)) {
                $result .= join '', map { md_color('code_block', $_) }
                    split /(?<=\n)/, $body;
            }
            $result .= md_color('code_mark', "$ci$fence") . $trail;
            protect($result)
        }mge;
    },
    comments => sub {
        s/(^<!--(?![->])(?s:.*?)-->)/protect(md_color('comment', $1))/mge;
    },
    image_links => sub {
        s{\[!\[($LT)\]\(([^)\n]+)\)\]\(<?([^>)\s\n]+)>?\)}{
            protect(
                osc8($2, md_color('image_link', "!"))
                . osc8($3, md_color('image_link', "[$1]"))
            )
        }ge;
    },
    images => sub {
        s{!\[($LT)\]\(<?([^>)\s\n]+)>?\)}{
            protect(osc8($2, md_color('image', "![$1]")))
        }ge;
    },
    links => sub {
        s{(?<![!\e])\[($LT)\]\(<?([^>)\s\n]+)>?\)}{
            protect(osc8($2, md_color('link', "[$1]")))
        }ge;
    },
    inline_code => sub {
        s/(?<bt>`++)(((?!\g{bt}).)+)(\g{bt})/
            protect(md_color('code_tick', $+{bt}) . md_color('code_inline', $2) . md_color('code_tick', $4))
        /ge;
    },
    headings => sub {
        my $hashed = $config->{hashed};
        for my $n (reverse 1..6) {
            next unless active("h$n");