Arch::FileHighlighter - syntax-highlight file's content using markup

Arch documentation Contained in the Arch distribution.

Index

Code Index:

NAME

Top

Arch::FileHighlighter - syntax-highlight file's content using markup

SYNOPSIS

Top

    use Arch::FileHighlighter;
    my $fh = Arch::FileHighlighter->new(
        [ 'internal(pm+c)', 'none(txt), 'enscript', 'internal', ]
    );

    my $html_ref = $fh->highlight($0);
    print $$html_ref;

    print ${$fh->highlight('file.c', '/* some code */')};

DESCRIPTION

Top

This class processes file contents and produces syntax highlighting markup. This may be used together with css that defines exact text colors and faces.

The default is to use the builtin "internal" processing, that is pretty poor; only very basic file types and syntax constructions are supported. It is suggested to configure and use the external "enscript" utility. GNU enscript understands quite a rich number of file types and produces a useful syntax highlighting. "enscript" filter is used by default if /usr/bin/enscript is found.

It is possible to configure different filters ("none", "internal", "enscript") depending on file name extension. In any case the resulting markup is always unified, i.e. all special characters are HTML-encoded using SGML entities, and the markup that looks like <spanclass="syntax_foo">bar</span> is used.

METHODS

Top

The following methods are available:

new, instance, highlight.

new [filters]

Create a new instance of Arch::FileHighlighter.

filters is arrayref of strings of the form filter(ext1+ext2+...)", where filter is one of "enscript", "internal" or "none". Special extension ":xml" is a shortcut for "html+htm+sgml+xml+wml+rss+glade". The filters optionally constrained by file extensions are probed sequentially and the first passed one is used.

Note that if enscript is configured in the sequence, but is not installed, then its probing may print a warning to stderr. The "enscript" filter is handled a bit specially, it may take parameters "mono" (less colors) and "asis" instead of the file extensions. If enscript returns html without any tags, then the filter is handled as failed, unless "asis" is given.

By default, filters is [ 'internal' ], or [ 'enscript', 'internal' ] depending on presense of '/usr/bin/enscript'.

instance [filters]

Alternative constructor. Return the last created instance of Arch::FileHighlighter or create a new one.

The purpose of this alternative constructor is to allow the singleton behaviour as well as certain Aspect Oriented Programming practices.

highlight filename [content]

Process filename using configured filters (as described in the constructor) and produce the file content with embeded <span class="class">...</span> markup. class is one of:

    syntax_keyword
    syntax_builtin
    syntax_comment
    syntax_special
    syntax_funcdef
    syntax_vartype
    syntax_string
    syntax_constant

If content is provided (either string or reference to string), it is used, otherwise the content of filename is loaded.

BUGS

Top

Awaiting for your reports.

AUTHORS

Top

Mikhael Goikhman (migo@homemail.com--Perl-GPL/arch-perl--devel).

SEE ALSO

Top

For more information, see enscript, Arch::Util, Syntax::Highlight::Perl.

Arch documentation Contained in the Arch distribution. 
# Arch Perl library, Copyright (C) 2004-2005 Mikhael Goikhman
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use 5.005;
use strict;

package Arch::FileHighlighter;

use Arch::Util qw(run_cmd load_file save_file);

sub new ($;$) {
	my $class = shift;
	my $filters = shift;
	$filters ||= [ (-x '/usr/bin/enscript'? 'enscript': ()), 'internal' ];

	my $self = {
		filters => $filters,
	};
	bless $self, $class;

	no strict 'refs';
	${"${class}::global_instance"} = $self;
	return $self;
}

sub instance ($;$) {
	my $class = shift;

	no strict 'refs';
	return ${"${class}::global_instance"} || $class->new(@_);
}

sub htmlize ($) {
	my $str = shift;
	die "No content to htmlize" unless defined $str;

	$str =~ s/&/&amp;/sg;
	$str =~ s/\"/&quot;/sg;
	$str =~ s/</&lt;/sg;
	$str =~ s/>/&gt;/sg;
	return $str;
}

sub dehtmlize ($) {
	my $str = shift;
	die "No content to dehtmlize" unless defined $str;

	$str =~ s/&amp;/&/sg;
	$str =~ s/&quot;/\"/sg;
	$str =~ s/&lt;/</sg;
	$str =~ s/&gt;/>/sg;
	return $str;
}

sub highlight ($$;$) {
	my $self = shift;
	my $file_name = shift;
	my $content = shift;

	load_file($file_name, \$content) unless defined $content;
	my $content_ref = ref($content) eq 'SCALAR'? $content: \$content;

	return undef if -B $file_name;

	foreach (@{$self->{filters}}) {
		# make sure we actually copy $_ and not work in-place
		my $filter = $_;
		my %args = ();
		if ($filter =~ /(.*)\((.*)\)/) {
			$filter = $1;
			my $args = $2;
			%args = map { /^(.+?)=(.*)$/? ($1 => $2): ($_ => 1) }
				split(/[^:\w=]+/, $args);
		}
		my $method = "_highlight_$filter";
		unless ($self->can($method)) {
			warn qq(Arch::FileHighlighter: unknown filter "$filter"\n);
			next;
		}
		my $html_ref = $self->$method($file_name, $content_ref, %args);
		return $html_ref if $html_ref;
	}
	$self->_highlight_none($file_name, $content_ref);
}

sub _highlight_enscript ($$$%) {
	my $self = shift;
	my $file_name = shift;
	my $content_ref = shift;
	my %args = @_;

	my $tmp;
	if ($content_ref) {
		require Arch::TempFiles;
		$tmp = Arch::TempFiles->new;
		$file_name =~ m!^(.*/|^)([^/]+)$! || die "Invalid file name ($file_name)\n";
		$file_name = $tmp->dir("highlight") . "/$2";
		save_file($file_name, $content_ref);
	}

	my @enscript_args = qw(enscript --output - --quiet --pretty-print);
	push @enscript_args, "--color" unless $args{"mono"};
	push @enscript_args, "--language", "html", $file_name;
	my $html = eval { run_cmd(@enscript_args) };
	return undef unless $html;

	$html =~ s!^.*<PRE>\n?!!s; $html =~ s!</PRE>.*$!!s;
	return undef unless $args{"asis"} || $html =~ /</;

	for (1 .. 3) {
		my $dot = $_ == 3? ".": "[^<]";
		$html =~ s!<B><FONT COLOR="#A020F0">($dot*?)</FONT></B>!<span class="syntax_keyword">$1</span>!sg;
		$html =~ s!<B><FONT COLOR="#DA70D6">($dot*?)</FONT></B>!<span class="syntax_builtin">$1</span>!sg;
		$html =~ s!<I><FONT COLOR="#B22222">($dot*?)</FONT></I>!<span class="syntax_comment">$1</span>!sg;
		$html =~ s!<B><FONT COLOR="#5F9EA0">($dot*?)</FONT></B>!<span class="syntax_special">$1</span>!sg;
		$html =~ s!<B><FONT COLOR="#0000FF">($dot*?)</FONT></B>!<span class="syntax_funcdef">$1</span>!sg;
		$html =~ s!<B><FONT COLOR="#228B22">($dot*?)</FONT></B>!<span class="syntax_vartype">$1</span>!sg;
		$html =~ s!<B><FONT COLOR="#BC8F8F">($dot*?)</FONT></B>!<span class="syntax_string">$1</span>!sg;
		$html =~ s!<FONT COLOR="#228B22"><B>($dot*?)</FONT></B>!<span class="syntax_vartype">$1</span>!sg;
		$html =~ s!<FONT COLOR="#BC8F8F"><B>($dot*?)</FONT></B>!<span class="syntax_string">$1</span>!sg;
		$html =~ s!<FONT COLOR="#B8860B">($dot*?)</FONT>!<span class="syntax_constant">$1</span>!sg;
	}
	$html =~ s!<B>(.*?)</B>!<span class="syntax_keyword">$1</span>!sg;
	$html =~ s!<I>(.*?)</I>!<span class="syntax_comment">$1</span>!sg;
	$html =~ s!</FONT></B>!!sg;  # enscript bug with perl highlightling
	$html =~ s!(\r?\n)((?:</span>)+)!$2$1!g;
	return \$html;
}

sub _match_file_extension ($$) {
	my $file_name = shift;
	my $args = shift;

	while (my ($ext, $value) = each %$args) {
		return 1 if $value && $file_name =~ /\.$ext(\.in)?$/i;
	}
	return 0;
}

sub _highlight_internal ($$$%) {
	my $self = shift;
	my $file_name = shift;
	my $content_ref = shift;
	my %args = @_;

	my @xml_extensions = qw(html htm shtml sgml xml wml rss glade);
	my $xml_extension_regexp = join('|', @xml_extensions);

	if (%args) {
		if (exists $args{':xml'}) {
			my $value = delete $args{':xml'};
			$args{$_} = $value foreach @xml_extensions;
		}
		return undef unless _match_file_extension($file_name, \%args);
	}

	print STDERR "internal highlighting for $file_name\n"
		if $ENV{DEBUG} && ("$ENV{DEBUG}" & "\1") ne "\0";
	my $html = htmlize($$content_ref);
	$file_name =~ s/\.in$//;
	$file_name = lc($file_name);

	if ($file_name =~ /\.(ac|am|conf|m4|pl|pm|po|py|rb|sh|sql)$/ || $html =~ /^#!/) {
		$html =~ s!^([ \t]*)(#.*)!$1<span class="syntax_comment">$2</span>!mg;
	}
	if ($file_name =~ /\.(lisp|lsp|scm|scheme)$/) {
		$html =~ s!^([ \t]*)(;.*)!$1<span class="syntax_comment">$2</span>!mg;
	}
	if ($file_name =~ /\.(c|cc|cpp|cxx|c\+\+|h|hpp|idl|php|xpm|l|y)$/) {
		$html =~ s!(^|[^\\:])(//.*)!$1<span class="syntax_comment">$2<\/span>!g;
		$html =~ s!(^|[^\\])(/\*.*?\*/)!$1<span class="syntax_comment">$2<\/span>!sg;
	}
	if ($file_name =~ /(^configure(\.ac)?|\.m4)$/) {
		$html =~ s!(\bdnl\b.*)!<span class="syntax_comment">$1<\/span>!g;
		$html =~ s!\b(m4_\w+)\b!<span class="syntax_builtin">$1<\/span>!g;
		$html =~ s!\b(if|then|else|fi)\b!<span class="syntax_keyword">$1<\/span>!g;
	}
	if ($file_name =~ /\.($xml_extension_regexp)$/) {
		$html =~ s!(&lt;\!--.*?--&gt;)!<span class="syntax_comment">$1<\/span>!sg;
		$html =~ s!(&lt;/?\w+.*?&gt;)!<span class="syntax_keyword">$1<\/span>!sg;
		while ($html =~ s!(>(?:&lt;[\w-]+)?\s+)([\w-]+)(=)("[^"]*"|'[^']'|[^\s]*)!$1<span class="syntax_special">$2<\/span>$3<span class="syntax_string">$4<\/span>!sg) {}
	}
	return \$html;
}

sub _highlight_none ($$$%) {
	my $self = shift;
	my $file_name = shift;
	my $content_ref = shift;
	my %args = @_;

	if (%args) {
		return undef unless _match_file_extension($file_name, \%args);
	}

	my $html = htmlize($$content_ref);
	return \$html;
}

1;

__END__