Text-VimColor-0.11/0000755000175000017500000000000010376147041012222 5ustar qefqefText-VimColor-0.11/t/0000755000175000017500000000000010376147041012465 5ustar qefqefText-VimColor-0.11/t/10cmp.t0000644000175000017500000000173510375727552013612 0ustar qefqef# Check that things which should produce identical output do. use strict; use warnings; use Test::More; use Text::VimColor; use Path::Class qw( file ); plan tests => 2; # Check that passing coloring with the 'filetype' option has the same output # whether Vim knows the filename or not. my $filename = file('t', 'hello.c')->stringify; my $syntax1 = Text::VimColor->new( file => $filename, filetype => 'c', ); open my $file, '<', $filename or die "error opening file '$filename': $!"; my $text = do { local $/; <$file> }; my $syntax2 = Text::VimColor->new( string => $text, filetype => 'c', ); is($syntax1->html, $syntax2->html, 'check that HTML output for hello.c comes out right'); # Same again, but this time use a reference to a string. my $syntax3 = Text::VimColor->new( string => \$text, filetype => 'c', ); is($syntax1->html, $syntax3->html, 'check that HTML output for hello.c comes out right using a string ref'); # vim:ft=perl ts=3 sw=3 expandtab: Text-VimColor-0.11/t/hello.c0000644000175000017500000000026610375656620013747 0ustar qefqef#include #include int main (int argc, char **argv) { if (argc > 1) { printf("%s\n", argv[1]); } printf("hello !\n"); return 0; } Text-VimColor-0.11/t/02file.t0000644000175000017500000000064710375721017013742 0ustar qefqef# Check that we can deal with input files properly. use strict; use warnings; use Test::More; use Text::VimColor; plan tests => 1; # We should get a sensible error message if the named file isn't there. eval { Text::VimColor->new( file => 'some-random-non-existant-file.txt' ) }; like($@, qr/input file '.*' not found/, "check we get the right error if the file doesn't exist"); # vim:ft=perl ts=3 sw=3 expandtab: Text-VimColor-0.11/t/table.sql.xml0000644000175000017500000000040110375733301015066 0ustar qefqefcreate table foo ( id integer not null ); Text-VimColor-0.11/t/shell.bash.xml0000644000175000017500000000034410205627410015225 0ustar qefqefecho $(date) Text-VimColor-0.11/t/table.borked.xml0000644000175000017500000000022710375733310015543 0ustar qefqefcreate table foo ( id integer not null ); Text-VimColor-0.11/t/99pod.t0000644000175000017500000000226310125543015013612 0ustar qefqef# Validate the POD documentation in all Perl modules (*.pm) under the 'lib' # directory. Prints a warning if no documentation was found (because that # probably means you should write some). use strict; use warnings; use Test; use File::Find; use Pod::Checker; use File::Temp qw( tempfile ); use IO::File; # Each test is for a particular '.pm' file, so we need to find how many # there are before we plan the tests. my @pm; find({ wanted => \&wanted, no_chdir => 1 }, 'lib'); push @pm, 'text-vimcolor'; sub wanted { return unless -f; return unless /\.pm$/; push @pm, $_; } plan tests => scalar @pm; foreach (@pm) { # Warnings are sent to a temporary file. my ($log_file, $log_filename) = tempfile(); my $s = podchecker($_, $log_file, '-warnings' => 2); close $log_file; warn "\n$_: no documentation.\n" if $s < 0; if ($s > 0) { $log_file = IO::File->new($log_filename, 'r') or die "$0: error rereading log file '$log_filename': $!\n"; my $log = do { local $/; <$log_file> }; warn "\n$log\n"; } ok($s <= 0); unlink $log_filename; } # Local Variables: # mode: perl # perl-indent-level: 3 # End: # vim:ft=perl ts=3 sw=3 expandtab: Text-VimColor-0.11/t/has_tabs.pl0000644000175000017500000000015110017202355014573 0ustar qefqef# Perl script containing tabs. if (@ARGV) { for (1 .. shift) { print "Number $_", "\n"; } } Text-VimColor-0.11/t/20override.t0000644000175000017500000000250310375733460014640 0ustar qefqef# Test that options in calls syntax_mark_file() and syntax_mark_string() # override the ones passed to new(). use strict; use warnings; use Test::More; use Text::VimColor; use Path::Class qw( file ); plan tests => 4; my $syntax = Text::VimColor->new( filetype => 'perl', ); my $input_filename = file('t', 'table.sql')->stringify; my $input = load_file('table.sql'); my $expected_sql = load_file('table.sql.xml'); my $expected_borked = load_file('table.borked.xml'); $syntax->syntax_mark_file($input_filename, filetype => 'sql'); my $output = $syntax->xml; $output =~ s/ filename=".*?"//; is($output, $expected_sql, 'syntax_mark_file options override defaults'); $syntax->syntax_mark_file($input_filename); $output = $syntax->xml; $output =~ s/ filename=".*?"//; is($output, $expected_borked, 'syntax_mark_file goes back to defaults'); $syntax->syntax_mark_string($input, filetype => 'sql'); is($syntax->xml, $expected_sql, 'syntax_mark_string options override defaults'); $syntax->syntax_mark_string($input); is($syntax->xml, $expected_borked, 'syntax_mark_string is back to defaults'); sub load_file { my ($filename) = @_; $filename = file('t', $filename)->stringify; open my $file, '<', $filename or die "error opening file '$filename': $!"; return do { local $/; <$file> }; } # vim:ft=perl ts=3 sw=3 expandtab: Text-VimColor-0.11/t/table.sql0000644000175000017500000000005610375730034014275 0ustar qefqefcreate table foo ( id integer not null ); Text-VimColor-0.11/t/shell.sh0000644000175000017500000000001510125347741014125 0ustar qefqefecho $(date) Text-VimColor-0.11/t/01array.t0000644000175000017500000000552710375721002014134 0ustar qefqef# Check that the right things are being marked by the syntax highlighting # for some test cases, and make sure we can get the results out as a Perl # array of hashes. # # This also tests using a string as input rather than a file. use strict; use warnings; use Test::More; use Text::VimColor; plan tests => 7 + 2 * 3; # Making an object. my $syntax = Text::VimColor->new; is(ref $syntax, 'Text::VimColor', 'new() should return Text::VimColor object'); # Without a filename or string specified, marked() should die. eval { $syntax->marked }; like($@, qr/an input file or string must be specified/, 'without a filename or string specified, marked() should die'); is($syntax->input_filename, undef, 'without a filename or string specified, input_filename() should be undef'); # The 'string' and 'file' options should be mutually exclusive. eval { Text::VimColor->new( file => 'foo', string => 'bar') }; like($@, qr/only one of the 'file' or 'string' options/, "the 'string' and 'file' options should be mutually exclusive"); # Test markup of some XML, and check format of Perl array output. my $xml_input = "text\n"; my $xml_expected = [ [ 'Identifier', '' ], [ '', 'text' ], [ 'Identifier', '' ], [ '', "\n" ], ]; $syntax = Text::VimColor->new(filetype => 'xml'); my $xml_marked1 = $syntax->syntax_mark_string($xml_input)->marked; $syntax = Text::VimColor->new(string => $xml_input, filetype => 'xml'); my $xml_marked2 = $syntax->marked; ok(syncheck($xml_expected, $xml_marked1), 'markup works with string input to syntax_mark_string()'); ok(syncheck($xml_expected, $xml_marked2), 'markup works using string input and marked()'); # Check filename when input was a string. is($syntax->input_filename, undef, 'when input is a string, input_filename() should be undef'); # Runs 3 tests through the testing infrastructure. sub syncheck { my ($expected, $marked) = @_; isnt($marked, undef, "syntax markup shouldn't be undef"); is(ref $marked, 'ARRAY', "syntax markup should be an array ref"); is(@$marked, @$expected, "syntax markup should have the expected number of elements"); for my $i (0 .. $#$expected) { my $e = $expected->[$i]; my $m = $marked->[$i]; unless (defined $m) { diag "element $i not defined"; return; } unless (ref $m eq 'ARRAY') { diag "element $i not an array ref"; return; } unless (@$m == 2) { diag "element $i has size " . scalar(@$m) . ", not two"; return; } unless ($m->[0] eq $e->[0]) { diag "element $i has type '$m->[0]', not '$e->[0]'"; return; } unless ($m->[1] eq $e->[1]) { diag "element $i has text '$m->[0]', not '$e->[0]'"; return; } } return 1; } # vim:ft=perl ts=3 sw=3 expandtab: Text-VimColor-0.11/t/05xml.t0000644000175000017500000001014310017211067013606 0ustar qefqef# Check that the XML output is correct. # Also checks that tabs aren't tampered with. use strict; use warnings; use Test::More; use Text::VimColor; use IO::File; my $NS = 'http://ns.laxan.com/text-vimcolor/1'; my %SYNTYPES = map { $_ => 1 } qw( Comment Constant Identifier Statement Preproc Type Special Underlined Error Todo ); my @EXPECTED_PERL_SYN = qw( Comment Statement Identifier Statement Constant Statement Statement Constant Identifier Constant Constant Special Constant ); my @EXPECTED_NOFT_SYN = qw( Comment Constant Constant ); eval " use XML::Parser "; if ($@) { plan skip_all => 'XML::Parser module required for these tests.'; exit 0; } else { plan tests => 12; } # Syntax color a Perl program, and check the XML output for well-formedness # and validity. The tests are run with and without a root element in the # output, and with both filename and string as input. my $filename = 't/has_tabs.pl'; my $file = IO::File->new($filename, 'r') or die "error opening file '$filename': $!"; my $data = do { local $/; <$file> }; my $syntax = Text::VimColor->new( file => $filename, ); my $syntax_noroot = Text::VimColor->new( file => $filename, xml_root_element => 0, ); my $syntax_str = Text::VimColor->new( string => $data, ); my $syntax_str_noroot = Text::VimColor->new( string => $data, xml_root_element => 0, ); my %syntax = ( 'no root element, filename input' => $syntax_noroot, 'no root element, string input' => $syntax_str_noroot, 'root element, filename input' => $syntax, 'root element, string input' => $syntax_str, ); # These are filled in by the handler subs below. my $text; my $root_elem_count; my $inside_element; my @syntax_types; my $parser = XML::Parser->new( Handlers => { Start => \&handle_start, End => \&handle_end, Char => \&handle_text, Default => \&handle_default, }, ); foreach my $test_type (sort keys %syntax) { #diag("Doing XML tests for configuration '$test_type'."); my $syn = $syntax{$test_type}; my $xml = $syn->xml; # The ones without root elements need to be faked. if ($test_type =~ /no root/) { $xml = "$xml"; } # Reset globals. $text = ''; $root_elem_count = 0; $inside_element = 0; @syntax_types = (); $parser->parse($xml); is($text, $data, "check that text from XML output matches original"); is($root_elem_count, 1, "there should only be one root element"); if ($test_type =~ /string/) { # Only expected to find string literals and comments. is_deeply(\@EXPECTED_NOFT_SYN, \@syntax_types, "check that the syntax types marked come in the right order"); } else { is_deeply(\@EXPECTED_PERL_SYN, \@syntax_types, "check that the syntax types marked come in the right order"); } } sub handle_text { my ($expat, $s) = @_; $text .= $s; } sub handle_start { my ($expat, $element, %attr) = @_; $element =~ /^syn:(.*)\z/ or fail("element <$element> has wrong prefix"), return; $element = $1; fail("element shouldn't be nested in something") if $inside_element; if ($element eq 'syntax') { ++$root_elem_count; fail("namespace declaration missing from root element") unless $attr{'xmlns:syn'}; fail("wrong namespace declaration in root element") unless $attr{'xmlns:syn'} eq $NS; } else { $inside_element = 1; fail("bad element ") if !$SYNTYPES{$element}; fail("element shouldn't have any attributes") if keys %attr; push @syntax_types, $element; } } sub handle_end { my ($expat, $element) = @_; $element =~ /^syn:(.*)\z/ or fail("element <$element> has wrong prefix"), return; $element = $1; $inside_element = 0; if ($element ne 'syntax' && !$SYNTYPES{$element}) { fail("bad element "); return; } } sub handle_default { my ($expat, $s) = @_; return unless $s =~ /\S/; die "unexpected XML event for text '$s'\n"; } # vim:ft=perl ts=3 sw=3 expandtab: Text-VimColor-0.11/t/shell.sh.xml0000644000175000017500000000033410205632045014721 0ustar qefqefecho $(date) Text-VimColor-0.11/t/15let.t0000644000175000017500000000573210375721040013607 0ustar qefqef# Check that things which should produce identical output do. use strict; use warnings; use Test::More; use Text::VimColor; use Path::Class qw( file ); # If the version of Vim is too old to do the right shell-script highlighting, # then just don't bother. { open my $vim, '-|', 'vim --version' or die "error running 'vim --version': $!"; my $line = <$vim>; die "couldn't read version from 'vim --version'" unless defined $line; if ($line =~ / (\d+)\.(\d+) / && ($1 >= 7 || ($1 == 6 && $2 >= 3))) { plan tests => 7; } else { plan skip_all => 'need Vim 6.3 for this to work'; } } my $input = load_file('shell.sh'); my $expected_sh_output = load_file('shell.sh.xml'); my $expected_bash_output = load_file('shell.bash.xml'); # First test setting 'let' values in the constructor. { my $syntax = Text::VimColor->new( string => $input, filetype => 'sh', ); is($syntax->xml, $expected_bash_output, 'by default shell should enable bash features'); } { my $syntax = Text::VimColor->new( string => $input, filetype => 'sh', vim_let => { 'b:is_bash' => undef }, ); is($syntax->xml, $expected_sh_output, 'shell should disable bash features with b:is_bash=undef'); } { my $syntax = Text::VimColor->new( string => $input, filetype => 'sh', vim_let => { 'b:is_bash' => 1 }, ); is($syntax->xml, $expected_bash_output, 'shell should enable bash features with b:is_bash=1'); } # now test setting 'let' values with the 'vim_let' method. { my $syntax = Text::VimColor->new( filetype => 'sh', # TODO - move to syntax_mark_string() ); $syntax->syntax_mark_string($input); is($syntax->xml, $expected_bash_output, 'by default shell should enable bash features (two-step marking)'); } { my $syntax = Text::VimColor->new( filetype => 'sh', # TODO - move to syntax_mark_string() ); $syntax->vim_let('b:is_bash' => undef); $syntax->syntax_mark_string($input); is($syntax->xml, $expected_sh_output, 'shell should disable bash features with vim_let(b:is_bash=>undef)'); } { my $syntax = Text::VimColor->new( filetype => 'sh', # TODO - move to syntax_mark_string() ); $syntax->vim_let(foo => '"bar"', 'b:is_bash' => undef); $syntax->syntax_mark_string($input); is($syntax->xml, $expected_sh_output, 'disable bash features with vim_let(foo=>"bar", b:is_bash=>undef)'); } { my $syntax = Text::VimColor->new( filetype => 'sh', # TODO - move to syntax_mark_string() ); $syntax->vim_let('b:is_bash' => 1); $syntax->syntax_mark_string($input); is($syntax->xml, $expected_bash_output, 'shell should enable bash features with vim_let(b:is_bash=>1)'); } sub load_file { my ($filename) = @_; $filename = file('t', $filename)->stringify; open my $file, '<', $filename or die "error opening file '$filename': $!"; return do { local $/; <$file> }; } # vim:ft=perl ts=3 sw=3 expandtab: Text-VimColor-0.11/lib/0000755000175000017500000000000010376147041012770 5ustar qefqefText-VimColor-0.11/lib/Text/0000755000175000017500000000000010376147041013714 5ustar qefqefText-VimColor-0.11/lib/Text/VimColor.pm0000644000175000017500000005405310376143625016017 0ustar qefqefpackage Text::VimColor; use warnings; use strict; use IO::File; use File::Copy qw( copy ); use File::Temp qw( tempfile ); use Path::Class qw( file ); use Carp; die "Text::VimColor can't see where it's installed" unless -f __FILE__; our $SHARED = file(__FILE__)->dir->subdir('VimColor')->stringify; our $VERSION = '0.11'; our $VIM_COMMAND = 'vim'; our @VIM_OPTIONS = (qw( -RXZ -i NONE -u NONE -N ), "+set nomodeline"); our $NAMESPACE_ID = 'http://ns.laxan.com/text-vimcolor/1'; our %VIM_LET = ( perl_include_pod => 1, 'b:is_bash' => 1, ); our %SYNTAX_TYPE = ( Comment => 1, Constant => 1, Identifier => 1, Statement => 1, PreProc => 1, Type => 1, Special => 1, Underlined => 1, Error => 1, Todo => 1, ); # Set to true to print the command line used to run Vim. our $DEBUG = 0; sub new { my ($class, %options) = @_; $options{vim_command} = $VIM_COMMAND unless defined $options{vim_command}; $options{vim_options} = \@VIM_OPTIONS unless defined $options{vim_options}; $options{html_inline_stylesheet} = 1 unless exists $options{html_inline_stylesheet}; $options{xml_root_element} = 1 unless exists $options{xml_root_element}; $options{vim_let} = { %VIM_LET, (exists $options{vim_let} ? %{$options{vim_let}} : ()), }; croak "only one of the 'file' or 'string' options should be used" if defined $options{file} && defined $options{string}; my $self = bless \%options, $class; $self->_do_markup if defined $options{file} || defined $options{string}; return $self; } sub vim_let { my ($self, %option) = @_; while (my ($name, $value) = each %option) { $self->{vim_let}->{$name} = $value; } return $self; } sub syntax_mark_file { my ($self, $file, %options) = @_; local $self->{filetype} = exists $options{filetype} ? $options{filetype} : $self->{filetype}; local $self->{file} = $file; $self->_do_markup; return $self; } sub syntax_mark_string { my ($self, $string, %options) = @_; local $self->{filetype} = exists $options{filetype} ? $options{filetype} : $self->{filetype}; local $self->{string} = $string; $self->_do_markup; return $self; } sub html { my ($self) = @_; my $syntax = $self->marked; my $html = ''; $html .= $self->_html_header if $self->{html_full_page}; foreach (@$syntax) { $html .= _xml_escape($_->[1]), next if $_->[0] eq ''; $html .= "[0]\">" . _xml_escape($_->[1]) . ''; } $html .= "\n\n \n\n" if $self->{html_full_page}; return $html; } sub xml { my ($self) = @_; my $syntax = $self->marked; my $xml = ''; if ($self->{xml_root_element}) { my $filename = $self->input_filename; $xml .= "[1]), next if $_->[0] eq ''; $xml .= "[0]>" . _xml_escape($_->[1]) . "[0]>"; } $xml .= "\n" if $self->{xml_root_element}; return $xml; } sub marked { my ($self) = @_; exists $self->{syntax} or croak "an input file or string must be specified, either to 'new' or". " 'syntax_mark_file/string'"; return $self->{syntax}; } sub input_filename { my ($self) = @_; my $file = $self->{file}; return $file if defined $file && !ref $file; return undef; } # Return a string consisting of the start of an XHTML file, with a stylesheet # either included inline or referenced with a . sub _html_header { my ($self) = @_; my $input_filename = $self->input_filename; my $title = defined $self->{html_title} ? _xml_escape($self->{html_title}) : defined $input_filename ? _xml_escape($input_filename) : '[untitled]'; my $stylesheet; if ($self->{html_inline_stylesheet}) { $stylesheet = "\n"; } else { $stylesheet = "{html_stylesheet_url} || "file://$SHARED/light.css") . "\" />\n"; } "\n" . "\n" . " \n" . " $title\n" . " $stylesheet" . " \n" . " \n\n" . "
";
}

# Return a string safe to put in XML text or attribute values.  It doesn't
# escape single quotes (') because we don't use those to quote
# attribute values.
sub _xml_escape
{
   my ($s) = @_;
   $s =~ s/&/&/g;
   $s =~ s//>/g;
   $s =~ s/"/"/g;
   return $s;
}

# Actually run Vim and turn the script's output into a datastructure.
sub _do_markup
{
   my ($self) = @_;
   my $vim_syntax_script = file($SHARED, 'mark.vim')->stringify;

   croak "Text::VimColor syntax script '$vim_syntax_script' not installed"
      unless -f $vim_syntax_script && -r $vim_syntax_script;

   my $filename = $self->{file};
   my $input_is_temporary = 0;
   if (ref $self->{file}) {
      my $fh;
      ($fh, $filename) = tempfile();
      $input_is_temporary = 1;

      binmode $self->{file};
      binmode $fh;
      copy($self->{file}, $fh);
   }
   elsif (exists $self->{string}) {
      my $fh;
      ($fh, $filename) = tempfile();
      $input_is_temporary = 1;

      binmode $fh;
      print $fh (ref $self->{string} ? ${$self->{string}} : $self->{string});
   }
   else {
      croak "input file '$filename' not found"
         unless -f $filename;
      croak "input file '$filename' not accessible"
         unless -r $filename;
   }

   # Create a temp file to put the output in.
   my ($out_fh, $out_filename) = tempfile();

   # Create a temp file for the 'script', which is given to vim
   # with the -s option.  This is necessary because it tells Vim not
   # to delay for 2 seconds after displaying a message.
   my ($script_fh, $script_filename) = tempfile();
   my $filetype = $self->{filetype};
   my $filetype_set = defined $filetype ? ":set filetype=$filetype" : '';
   my $vim_let = $self->{vim_let};
   print $script_fh (map { ":let $_=$vim_let->{$_}\n" }
                     grep { defined $vim_let->{$_} }
                     keys %$vim_let),
                    ":filetype on\n",
                    "$filetype_set\n",
                    ":source $vim_syntax_script\n",
                    ":write! $out_filename\n",
                    ":qall!\n";
   close $script_fh;

   $self->_run(
      $self->{vim_command},
      @{$self->{vim_options}},
      $filename,
      '-s', $script_filename,
   );

   unlink $filename
      if $input_is_temporary;
   unlink $out_filename;
   unlink $script_filename;

   my $data = do { local $/; <$out_fh> };

   # Convert line endings to ones appropriate for the current platform.
   $data =~ s/\x0D\x0A?/\n/g;

   my $syntax = [];
   LOOP: {
      _add_markup($syntax, $1, $2), redo LOOP
         if $data =~ /\G>(.*?)>(.*?)<\1]+)/cgs;
   }

   $self->{syntax} = $syntax;
}

# Given an array ref ($syntax), we add a new syntax chunk to it, unescaping
# the text and making sure that consecutive chunks of the same type are
# merged.
sub _add_markup
{
   my ($syntax, $type, $text) = @_;

   # Ignore types we don't know about.  At least one syntax file (xml.vim)
   # can produce these.  It happens when a syntax type isn't 'linked' to
   # one of the predefined types.
   $type = ''
      unless exists $SYNTAX_TYPE{$type};

   # Unescape ampersands and pointies.
   $text =~ s/&l//g;
   $text =~ s/&a/&/g;

   if (@$syntax && $syntax->[-1][0] eq $type) {
      # Concatenate consecutive bits of the same type.
      $syntax->[-1][1] .= $text;
   }
   else {
      # A new chunk of marked-up text.
      push @$syntax, [ $type, $text ];
   }
}

# This is a private internal method which runs a program.
# It takes a list of the program name and arguments.
sub _run
{
   my ($self, $prog, @args) = @_;

   if ($DEBUG) {
      print STDERR __PACKAGE__."::_run: $prog " .
            join(' ', map { s/'/'\\''/g; "'$_'" } @args) . "\n";
   }

   my ($err_fh, $err_filename) = tempfile();
   my $old_fh = select($err_fh);
   $| = 1;
   select($old_fh);

   my $pid = fork;
   if ($pid) {
      my $gotpid = waitpid($pid, 0);
      croak "couldn't run the program '$prog'" if $gotpid == -1;
      my $error = $? >> 8;
      if ($error) {
         seek $err_fh, 0, 0;
         my $errout = do { local $/; <$err_fh> };
         $errout =~ s/\n+\z//;
         close $err_fh;
         unlink $err_filename;
         my $details = $errout eq '' ? '' :
                       "\nVim wrote this error output:\n$errout\n";
         croak "$prog returned an error code of '$error'$details";
      }
      close $err_fh;
      unlink $err_filename;
   }
   else {
      defined $pid
         or croak "error forking to run $prog: $!";
      open STDIN, '/dev/null';
      open STDOUT, '>/dev/null';
      open STDERR, '>&=' . fileno($err_fh)
         or croak "can't connect STDERR to temporary file '$err_filename': $!";
      exec $prog $prog, @args;
      die "\n";   # exec() will already have sent a suitable error message.
   }
}

1;

__END__

=head1 NAME

Text::VimColor - syntax color text in HTML or XML using Vim

=head1 SYNOPSIS

   use Text::VimColor;
   my $syntax = Text::VimColor->new(
      file => $0,
      filetype => 'perl',
   );

   print $syntax->html;
   print $syntax->xml;

=head1 DESCRIPTION

This module tries to markup text files according to their syntax.  It can
be used to produce web pages with pretty-printed colourful source code
samples.  It can produce output in the following formats:

=over 4

=item HTML

Valid XHTML 1.0, with the exact colouring and style left to a CSS stylesheet

=item XML

Pieces of text are marked with XML elements in a simple vocabulary,
which can be converted to other formats, for example, using XSLT

=item Perl array

A simple Perl data structure, so that Perl code can be used to turn it
into whatever is needed

=back

This module works by running the Vim text editor and getting it to apply its
excellent syntax highlighting (aka 'font-locking') to an input file, and mark
pieces of text according to whether it thinks they are comments, keywords,
strings, etc.  The Perl code then reads back this markup and converts it
to the desired output format.

This is an object-oriented module.  To use it, create an object with
the C function (as shown above in the SYNOPSIS) and then call methods
to get the markup out.

=head1 METHODS

=over 4

=item new(I)

Returns a syntax highlighting object.  Pass it a hash of options.

The following options are recognised:

=over 4

=item file

The file to syntax highlight.  Can be either a filename or an open file handle.

Note that using a filename might allow Vim to guess the file type from its
name if none is specified explicitly.

If the file isn't specified while creating the object, it can be given later
in a call to the C method (see below), allowing a single
Text::VimColor object to be used with multiple input files.

=item string

Use this to pass a string to be used as the input.  This is an alternative
to the C option.  A reference to a string will also work.

The C method (see below) is another way to use a string
as input.

=item filetype

Specify the type of file Vim should expect, in case Vim's automatic
detection by filename or contents doesn't get it right.  This is
particularly important when providing the file as a string of file
handle, since Vim won't be able to use the file extension to guess
the file type.

The filetypes recognised by Vim are short strings like 'perl' or 'lisp'.
They are the names of files in the 'syntax' directory in the Vim
distribution.

This option, whether or not it is passed to C, can be overridden
when calling C and C, so you can
use the same object to process multiple files of different types.

=item html_full_page

By default the C output method returns a fragment of HTML, not a
full file.  To make useful output this must be wrapped in a CpreE>
element and a stylesheet must be included from somewhere.  Setting the
C option will instead make the C method return a
complete stand-alone XHTML file.

Note that while this is useful for testing, most of the time you'll want to
put the syntax highlighted source code in a page with some other content,
in which case the default output of the C method is more appropriate.

=item html_inline_stylesheet

Turned on by default, but has no effect unless C is also
enabled.

This causes the CSS stylesheet defining the colours to be used
to render the markup to be be included in the HTML output, in a
CstyleE> element.  Turn it off to instead use a ClinkE>
to reference an external stylesheet (recommended if putting more than one
page on the web).

=item html_stylesheet

Ignored unless C and C are both
enabled.

This can be set to a stylesheet to include inline in the HTML output (the
actual CSS, not the filename of it).

=item html_stylesheet_file

Ignored unless C and C are both
enabled.

This can be the filename of a stylesheet to copy into the HTML output,
or a file handle to read one from.  If neither this nor C
are given, the supplied stylesheet F will be used instead.

=item html_stylesheet_url

Ignored unless C is enabled and C
is disabled.

This can be used to supply the URL (relative or absolute) or the stylesheet
to be referenced from the HTML ClinkE> element in the header.
If this isn't given it will default to using a C URL to reference
the supplied F stylesheet, which is only really useful for testing.

=item xml_root_element

By default this is true.  If set to a false value, XML output will not be
wrapped in a root element called , but will be otherwise the
same.  This could allow XML output for several files to be concatenated,
but to make it valid XML a root element must be added.  Disabling this
option will also remove the binding of the namespace prefix C, so
an C attribute would have to be added elsewhere.

=item vim_command

The name of the executable which will be run to invoke Vim.
The default is C.

=item vim_options

A reference to an array of options to pass to Vim.  The default options are:

   qw( -RXZ -i NONE -u NONE -N )

=item vim_let

A reference to a hash of options to set in Vim before the syntax file
is loaded.  Each of these is set using the C<:let> command to the value
specified.  No escaping is done on the values, they are executed exactly
as specified.

Values in this hash override some default options.  Use a value of
C to prevent a default option from being set at all.  The
defaults are as follows:

   (
      perl_include_pod => 1,     # Recognize POD inside Perl code
      'b:is_bash' => 1,          # Allow Bash syntax in shell scripts
   )

These settings can be modified later with the C method.

=back

=item vim_let(I =E I, ...)

Change the options that are set with the Vim C command when Vim
is run.  See C for details.

=item syntax_mark_file(I, I)

Mark up the specified file.  Subsequent calls to the output methods will then
return the markup.  It is not necessary to call this if a C or C
option was passed to C.

Returns the object it was called on, so an output method can be called
on it directly:

   my $syntax = Text::VimColor->new(
      vim_command => '/usr/local/bin/special-vim',
   );

   foreach (@files) {
      print $syntax->syntax_mark_file($_)->html;
   }

You can override the filetype set in new() by passing in a C
option, like so:

   $syntax->syntax_mark_file($filename, filetype => 'perl');

This option will only affect the syntax colouring for that one call,
not for any subsequent ones on the same object.

=item syntax_mark_string(I, I)

Does the same as C (see above) but uses a string as input.
I can also be a reference to a string.
Returns the object it was called on.  Supports the C option
just as C does.

=item html()

Return XHTML markup based on the Vim syntax colouring of the input file.

Unless the C option is set, this will only return a fragment
of HTML, which can then be incorporated into a full page.  The fragment
will be valid as either HTML and XHTML.

The only markup used for the actual text will be CspanE> elements
wrapped round appropriate pieces of text.  Each one will have a C
attribute set to a name which can be tied to a foreground and background
color in a stylesheet.  The class names used will have the prefix C,
for example C.  For the full list see the section
HIGHLIGHTING TYPES below.

=item xml()

Returns markup in a simple XML vocabulary.  Unless the C
option is turned off (it's on by default) this will produce a complete XML
document, with all the markup inside a CsyntaxE> element.

This XML output can be transformed into other formats, either using programs
which read it with an XML parser, or using XSLT.  See the
text-vimcolor(1) program for an example of how XSLT can be used with
XSL-FO to turn this into PDF.

The markup will consist of mixed content with elements wrapping pieces
of text which Vim recognized as being of a particular type.  The names of
the elements used are the ones listed in the HIGHLIGHTING TYPES section
below.

The CsyntaxE> element will declare the namespace for all the
elements prodeced, which will be C.
It will also have an attribute called C, which will be set to the
value returned by the C method, if that returns something
other than undef.

The XML namespace is also available as C<$Text::VimColor::NAMESPACE_ID>.

=item marked()

This output function returns the marked-up text in the format which the module
stores it in internally.  The data looks like this:

   use Data::Dumper;
   print Dumper($syntax->marked);

   $VAR1 = [
      [ 'Statement', 'my' ],
      [ '', ' ' ],
      [ 'Identifier', '$syntax' ],
      [ '', ' = ' ],
       ...
   ];

The C method returns a reference to an array.  Each item in the
array is itself a reference to an array of two items: the first is one of
the names listed in the HIGHLIGHTING TYPES section below (or the empty
string if none apply), and the second is the actual piece of text.

=item input_filename()

Returns the filename of the input file, or undef if a filename wasn't
specified.

=back

=head1 HIGHLIGHTING TYPES

The following list gives the names of highlighting types which will be
set for pieces of text.  For HTML output, these will appear as CSS class
names, except that they will all have the prefix C added.  For XML
output, these will be the names of elements which will all be in the
namespace C.

Here is the complete list:

=over 4

=item *

Comment

=item *

Constant

=item *

Identifier

=item *

Statement

=item *

PreProc

=item *

Type

=item *

Special

=item *

Underlined

=item *

Error

=item *

Todo

=back

=head1 RELATED  MODULES

These modules allow Text::VimColor to be used more easily in particular
environments:

=over 4

=item L

=item L

=item L

=back

=head1 SEE ALSO

=over 4

=item text-vimcolor(1)

A simple command line interface to this module's features.  It can be used
to produce HTML and XML output, and can also generate PDF output using
an XSLT/XSL-FO stylesheet and the FOP processor.

=item http://www.vim.org/

Everything to do with the Vim text editor.

=item http://ungwe.org/blog/

The author's weblog, which uses this module.  It is used to make the code
samples look pretty.

=back

=head1 BUGS

Quite a few, actually:

=over 4

=item *

Apparently this module doesn't always work if run from within a 'gvim'
window, although I've been unable to reproduce this so far.
CPAN bug #11555.

=item *

Things can break if there is already a Vim swapfile, but sometimes it
seems to work.

=item *

There should be a way of getting a DOM object back instead of an XML string.

=item *

It should be possible to choose between HTML and XHTML, and perhaps there
should be some control over the DOCTYPE declaration when a complete file is
produced.

=item *

With Vim versions earlier than 6.2 there is a 2 second delay each time
Vim is run.

=item *

It doesn't work on Windows.  I am unlikely to fix this, but if anyone
who knows Windows can sort it out let me know.

=back

=head1 AUTHOR

Geoff Richards Eqef@laxan.comE

The Vim script F is a crufted version of F<2html.vim> by
Bram Moolenaar EBram@vim.orgE and
David Ne\v{c}as (Yeti) Eyeti@physics.muni.czE.

=head1 COPYRIGHT

Copyright 2002-2006, Geoff Richards.

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

# Local Variables:
# mode: perl
# perl-indent-level: 3
# perl-continued-statement-offset: 3
# End:
# vi:ts=3 sw=3 expandtab:
Text-VimColor-0.11/lib/Text/VimColor/0000755000175000017500000000000010376147041015446 5ustar  qefqefText-VimColor-0.11/lib/Text/VimColor/mark.vim0000644000175000017500000000346510375641331017125 0ustar  qefqef" mark.vim - turn Vim syntax highlighting into an ad-hoc markup language that
" can be parsed by the Text::VimColor Perl module.
"
" Maintainer: Geoff Richards 
" Based loosely on 2html.vim, by Bram Moolenaar ,
"   modified by David Ne\v{c}as (Yeti) .

set report=1000000

" For some reason (I'm sure it used to work) we now need to get Vim
" to make another attempt to detect the filetype if it wasn't set
" explicitly.
if !strlen(&filetype)
   filetype detect
endif
syn on

" Set up the output buffer.
new
set modifiable
set paste

" Expand tabs. Without this they come out as '^I'.
set isprint+=9

wincmd p

" Loop over all lines in the original text
let s:end = line("$")
let s:lnum = 1
while s:lnum <= s:end

  " Get the current line
  let s:line = getline(s:lnum)
  let s:len = strlen(s:line)
  let s:new = ""

  " Loop over each character in the line
  let s:col = 1
  while s:col <= s:len
    let s:startcol = s:col " The start column for processing text
    let s:id = synID(s:lnum, s:col, 1)
    let s:col = s:col + 1
    " Speed loop (it's small - that's the trick)
    " Go along till we find a change in synID
    while s:col <= s:len && s:id == synID(s:lnum, s:col, 1) | let s:col = s:col + 1 | endwhile

    " Output the text with the same synID, with class set to c{s:id}
    let s:id = synIDtrans(s:id)
    let s:name = synIDattr(s:id, 'name')
    let s:new = s:new . '>' . s:name . '>' . substitute(substitute(substitute(strpart(s:line, s:startcol - 1, s:col - s:startcol), '&', '\&a', 'g'), '<', '\&l', 'g'), '>', '\&g', 'g') . '<' . s:name . '<'

    if s:col > s:len
      break
    endif
  endwhile

  exe "normal \pa" . strtrans(s:new) . "\n\e\p"
  let s:lnum = s:lnum + 1
  +
endwhile

" Strip whitespace from the ends of lines
%s:\s\+$::e

wincmd p
normal dd
Text-VimColor-0.11/lib/Text/VimColor/light.xsl0000644000175000017500000000775307761171232017324 0ustar  qefqef





 
  

   

    
    
     
     
     
    

    
    
     
     
     
    

    
     
      
      
     
    

   

   

    
    
     
      
     
    

    
    
     
      
     
    

    
    
     
      
     
    

   

  
 

 
  
 

 
  
 

 
  
 

 
  
 

 
  
 

 
  
 

 
  
 

 
  
 

 
  
 

 
  
 


Text-VimColor-0.11/lib/Text/VimColor/light.css0000644000175000017500000000213007605464105017267 0ustar  qefqef/*
 * A stylesheet designed to be used with the HTML output of the
 * Perl module Text::Highlight::Vim.
 *
 * This is designed to make the highlighting look like the default gvim
 * colour scheme, with 'background=light'.
 *
 * Geoff Richards (qef@laxan.com)
 *
 * This CSS file (light.css) is public domain.  Do what you want with it.
 * That doesn't mean that HTML with this CSS in is public domain.
 */

body { color: black; background: white none }

A:link { color: #00F; background: white none }
A:visited { color: #909; background: white none }
A:hover { color: #F00; background: white none }
A:active { color: #F00; background: white none }

.synComment    { color: #0000FF }
.synConstant   { color: #FF00FF }
.synIdentifier { color: #008B8B }
.synStatement  { color: #A52A2A ; font-weight: bold }
.synPreProc    { color: #A020F0 }
.synType       { color: #2E8B57 ; font-weight: bold }
.synSpecial    { color: #6A5ACD }
.synUnderlined { color: #000000 ; text-decoration: underline }
.synError      { color: #FFFFFF ; background: #FF0000 none }
.synTodo       { color: #0000FF ; background: #FFFF00 none }
Text-VimColor-0.11/MANIFEST0000644000175000017500000000054510376146434013364 0ustar  qefqefChangeLog
MANIFEST
META.yml
Makefile.PL
README
lib/Text/VimColor.pm
lib/Text/VimColor/light.css
lib/Text/VimColor/light.xsl
lib/Text/VimColor/mark.vim
t/01array.t
t/02file.t
t/05xml.t
t/10cmp.t
t/15let.t
t/20override.t
t/99pod.t
t/has_tabs.pl
t/hello.c
t/shell.bash.xml
t/shell.sh
t/shell.sh.xml
t/table.borked.xml
t/table.sql
t/table.sql.xml
text-vimcolor
Text-VimColor-0.11/META.yml0000644000175000017500000000017210376144766013506 0ustar  qefqef--- #YAML:1.0

name: Text-VimColor
version: 0.11
license: perl
distribution_type: module

requires:
    Path::Class: 0.02
Text-VimColor-0.11/ChangeLog0000644000175000017500000001352610376146760014012 0ustar  qefqeflibtext-vimcolor-perl (0.11-1) unstable; urgency=low

  * No code changes, just packaging fixes.

 -- Geoff Richards   Sun, 19 Feb 2006 19:32:27 +0000

libtext-vimcolor-perl (0.10-1) unstable; urgency=low

  * Be more careful about how 'exec' is called (belt & braces)

  * Improve error reporting.  Errors printed by the 'vim' command,
    as well as problems reported from 'exec' (like not being able
    to find the program) will now be reported (by getting passed
    through a temporary file).  Also, some 'die' calls were changed
    to 'croak'.

  * Allow the 'filetype' option to be overridden for each file
    processed, so that an object can be reused for multiple files
    of different types.

  * Provide a help/usage message in the text-vimcolor program.

  * Document which other CPAN modules use Text::VimColor, since
    you might find one of them be more useful than using it
    directly.

  * Various small corrections to the documentation.

 -- Geoff Richards   Sun, 19 Feb 2006 00:22:35 +0000

libtext-vimcolor-perl (0.09-1) unstable; urgency=low

  * Allow Vim options to be set with ':let' and provide a default
    option to make shell scripts be interpretted as Bash syntax,
    since it's a superset of Bourne shell.  Added corresponding
    options to 'text-vimcolor' script.

  * Added "+set nomodeline" option to Vim for belt-and-braces
    security.  Vim shouldn't read modelines with the default
    configuration enforced by the other options, but there's
    no harm being extra cautious.  Suggested by Ian Langworth.

  * If the 'vim' command fails, print the correct exit code in
    the error message.  Thanks to Smylers for the fix, and for
    reporting all the following bugs.
    (closes CPAN bug #11556).

  * Add documentation for the 'filetype' option to 'new()'.
    (closes CPAN bug #11558).

  * Document and test for using a reference to a scalar rather
    than just a plain scalar as the 'string' argument to 'new()'
    and the argument to 'syntax_mark_string()'.  It was already
    implemented but was mistakenly documented as a TODO.
    (closes CPAN bug #11557).

  * Document potential problem from CPAN bug #11555.

 -- Geoff Richards   Sat, 19 Feb 2005 13:28:28 +0000

libtext-vimcolor-perl (0.08-1) unstable; urgency=low

  * Tab characters weren't comming out right (you get "^I" instead
    of a literal tab).  Added ":set isprint+=9" to mark.vim to fix
    that.  Spotted and patched by Mario Xerri.

  * For some reason the filetype wasn't getting set right, so I've
    changed mark.vim to do ":filetype detect" when it wasn't already
    detected, and that seems to make it work.

  * The XML output sometimes produced an extra '>' after the start
    tag of the root element.  Fixed.

  * Added new file 05xml.t to the test suite and changed most of
    the tests to use Test::More instead of Test.

 -- Geoff Richards   Wed, 25 Feb 2004 22:03:17 +0000

libtext-vimcolor-perl (0.07-1) unstable; urgency=low

  * Now much faster!  By using the '-s' option when Vim is run, we
    avoid a 2 second delay while it tells us about the stdout not
    being connected to a terminal.  This only has an effect in Vim
    version 6.2 or later (behaviour changed in patch 6.1.191).

  * Fixed a bug reported by Giuseppe Maxia.  When Vim was run, it
    didn't do ":filetype on", so passing in a filetype explicitly
    didn't work.  It only worked if it could auto-detect the filetype.
    Added a test in 't/10cmp.t' which checks this, by using a string
    as input (so that there's no filename to guess the file type from).

 -- Geoff Richards   Tue, 9 Dec 2003 19:40:11 +0000

libtext-vimcolor-perl (0.06-1) unstable; urgency=low

  * The files which were in the 'shared' directory (XSLT and CSS
    stylesheets and the Vim script) are now in 'lib/Text/VimColor/'
    so that they get installed in a place the module can discover.
    Thanks to Giuseppe Maxia and Slaven Rezic for the tips.

  * Path::Class is now used (and is therefore a new dependency) to
    construct paths to files more portably.

  * Less confusing one-line description of text-vimcolor script.
  * Added the 'MANIFEST' file to itself, so that it gets shipped.
  * Distribute this ChangeLog (for my unofficial Debian package)
    rather than one generated out of CVS.

 -- Geoff Richards   Mon, 1 Dec 2003 18:43:13 +0000

libtext-vimcolor-perl (0.05-1) unstable; urgency=low

  * Include README file in distribution.

 -- Geoff Richards   Wed, 26 Nov 2003 21:59:38 +0000

libtext-vimcolor-perl (0.04-1) unstable; urgency=low

  * Fixed bug in the feature which allows us to override where the
    Vim script is installed.

 -- Geoff Richards   Wed, 26 Nov 2003 19:54:43 +0000

libtext-vimcolor-perl (0.03-1) unstable; urgency=low

  * Changed the namespace of the XML output.  This is definitely the
    final one.
  * Tweaked the behaviour of the 'input_filename()' method.
  * Minor adjustments to the documentation.
  * Added --debug option to the text-vimcolor program.

 -- Geoff Richards   Wed, 26 Nov 2003 19:40:20 +0000

libtext-vimcolor-perl (0.02-1) unstable; urgency=low

  * Added a test suite, although it's not finished yet.
  * Deal with unexpected syntax types.
  * Throw an error if the input file doesn't exist.
  * Brought the documentation up to date.
  * Install the output of 'cvs2cl' as an upstream changelog.

 -- Geoff Richards   Sat, 27 Sep 2003 19:28:16 +0100

libtext-vimcolor-perl (0.01-2) unstable; urgency=low

  * Corrected 'Build-Depends' to not depend on Perl 5.8.
  * Changed 'Build-Depends' to 'Build-Depends-Indep' to keep Lintian happy.

 -- Geoff Richards   Thu, 13 Mar 2003 22:26:41 +0000

libtext-vimcolor-perl (0.01-1) unstable; urgency=low

  * Initial Release.

 -- Geoff Richards   Sat,  4 Jan 2003 18:44:11 +0000

Text-VimColor-0.11/text-vimcolor0000755000175000017500000002035710375734672015006 0ustar  qefqef#!/usr/bin/perl -w
use strict;

use Text::VimColor;
use Getopt::Long;
use File::Temp qw( tempfile );
use IO::File;
use Path::Class qw( file );

my $XSL_STYLESHEET = file($Text::VimColor::SHARED, 'light.xsl');

# Default values for options.
my $filetype;
my $format;
my $usage;
my $output_filename;
my $html_full_page;
my $html_no_inline_stylesheet;
my @let;
my @unlet;

my $option = GetOptions(
   'debug' => \$Text::VimColor::DEBUG,
   'filetype=s' => \$filetype,
   'format=s' => \$format,
   'help' => \$usage,
   'output=s' => \$output_filename,
   'full-page' => \$html_full_page,
   'no-inline-stylesheet' => \$html_no_inline_stylesheet,
   'let=s' => \@let,
   'unlet=s' => \@unlet,
   'usage' => \$usage,
);

if ($usage) {
   print STDERR
      "Usage: $0 --format html|xml [options] filename\n",
      "       $0 --format pdf --output foo.pdf [options] filename\n",
      "(the output is written to standard output, except in PDF\n",
      "mode, where you have to supply a filename for the output.)\n",
      "\n",
      "Options:\n",
      "    --debug      turn on Text::VimColor debugging mode\n",
      "    --filetype   set Vim filetype name, if it can't be guessed from\n",
      "                 the file's name or contents\n",
      "    --format     set format to use for output, can be xml,\n",
      "                 html, or pdf\n",
      "    --help       show this helpful message\n",
      "    --output     set filename to write output to (required with\n",
      "                 PDF format, otherwise defaults to standard output)\n",
      "    --full-page  output a complete HTML page, not just a fragment\n",
      "    --no-inline-stylesheet\n",
      "                 don't include the stylesheet in a complete HTML page\n",
      "    --let        set a Vim variable with the Vim :let command\n",
      "    --unlet      turn off default setting of a Vim variable\n";
}

defined $format
   or die "$0: an output format must be specified (html, pdf or xml).\n";

$format = lc $format;
$format eq 'html' || $format eq 'pdf' || $format eq 'xml'
   or die "$0: invalid output format '$format' (must be html, pdf or xml).\n";

my $output;
if (defined $output_filename) {
   $output = IO::File->new($output_filename, 'w')
      or die "$0: error opening output file '$output_filename': $!\n";
}
else {
   $format ne 'pdf'
      or die "$0: an output file must be specified with '--format pdf'.\n";

   $output = \*STDOUT;
   $output_filename = '';
}

@ARGV <= 1
   or die "$0: only one input filename should be specified.\n";

my $file = @ARGV ? shift : \*STDIN;

my $syntax = Text::VimColor->new(
   filetype => $filetype,
   html_full_page => $html_full_page,
   html_inline_stylesheet => !$html_no_inline_stylesheet,
);

# Handle the --let and --unlet options.
foreach (@unlet) {
   $syntax->vim_let($_ => undef);
}
foreach (@let) {
   my ($name, $value) = /^(.*?)=(.*)\z/
      or die "$0: bad --let option '$_'\n";
   print STDERR "[$name] [$value]\n";
   $syntax->vim_let($name => $value);
}

$syntax->syntax_mark_file($file);

if ($format eq 'xml') {
   print $output $syntax->xml
      or die "$0: error writing to output file '$output_filename': $!\n";
}
elsif ($format eq 'html') {
   print $output $syntax->html
      or die "$0: error writing to output file '$output_filename': $!\n";
}
else {   # ($format eq 'pdf')
   my ($fh, $tmp_filename) = tempfile();
   print $fh $syntax->xml
      or die "$0: error writing to temporary file '$tmp_filename': $!\n";

   system('fop', '-xsl', $XSL_STYLESHEET,
                 '-xml', $tmp_filename,
                 '-pdf', $output_filename) == 0
      or die "$0: error running 'fop' (exit code was $?).\n";

   unlink $tmp_filename
      or die "$0: error deleting temporary file '$tmp_filename': $!\n";
}

exit 0;

__END__

=head1 NAME

text-vimcolor - command-line program to syntax color a file in HTML, XML or PDF

=head1 SYNOPSIS

   $ text-vimcolor --format html --full-page FILENAME > OUTPUT.html
   $ text-vimcolor --format xml FILENAME > OUTPUT.xml
   $ text-vimcolor --format pdf FILENAME --output OUTPUT.pdf

=head1 DESCRIPTION

This program uses the Vim text editor to highlight text according to its
syntax, and turn the highlighting into HTML, XML or PDF output.  It works
with any file type which Vim itself can highlight.  Usually Vim will be
able to autodetect the file format based on the filename (and sometimes the
contents of the file).

Exactly one filename should be given on the command line to name the input
file.  If none is given input will instead be read from stdin (the standard
input).

If Vim can't guess the file type automatically, it can be specified explicitly
using the C<--filetype> option.  For example:

   $ text-vimcolor --format html --filetype prolog foo.pl > foo.html

This program is a command line interface to the Perl module Text::VimColor.

=head1 OPTIONS

The following options are understood:

=over 4

=item --help

Show a summary of the usage, including a list of options.

=item --debug

Turns on debugging in the underlying Perl module.  This makes it print
the command used to run Vim.

=item --filetype I

Set the type of the file explicitly.  The I argument should be
something which Vim will recognise when set with its C option.
Examples are C, C (for C++) and C (for Unix shell scripts).
These names are case sensitive, and should usually be all-lowercase.

=item --format I

The output format to generate.  Must be one of the following:

=over 4

=item html

Generate XHTML output, with text marked with CspanE> elements
with C attributes.  A CSS stylesheet should be used to define the
coloring, etc., for the output.  See the C<--full-page> option below.

=item xml

Output is in a simple XML vocabulary.  This can then be used by other
software to do further transformations (e.g., using XSLT).

=item pdf

XML output is generated and fed to the FOP XSL-FO processor, with an
appropriate XSL style sheet.  The stylesheet uses XSLT to transform the
normal XML output into XSL-FO, which is then rendered to PDF.  For this
to work, the command C must be available.  An output file must be
specified with C<--output> with this format.

=back

Full details of the HTML and XML output formats can be found in the
documentation for Text::VimColor.

=item --output I

Specifies the name of the output file (which will end up containing either
HTML, XML or PDF).  If this option is omitted, the output will be sent
to stdout (the standard output).  This option is required when the output
format is PDF (because of limitations in FOP).

=item --full-page

When the output format is HTML, this option will make the output a complete
HTML page, rather than just a fragment of HTML.  A CSS stylesheet will be
inserted inline into the output, so the output will be useable as it is.

=item --no-inline-stylesheet

When the output format is HTML and C<--fullpage> is given, a stylesheet
is normally inserted in-line in the output file.  If this option is given it
will instead be referenced with a ClinkE> element.

=item --let I=I

When Vim is run the value of I will be set to I using
Vim's C command.  More than one of these options can be set.
The value is not quoted or escaped in any way, so it can be an expression.
These settings take precedence over C<--unlet> options.

This option corresponds to the C setting and method in
the Perl module.

=item --unlet I

Prevent the value of I being set with Vim's C command.
This can be used to turn off default settings.

This option corresponds to the C setting and method in
the Perl module, when used with a value of C.

=back

=head1 BUGS

=over 4

=item *

The PDF output option often doesn't work, because it is dependent on FOP,
which often doesn't work.  This is also why it is mind numbingly slow.

=item *

FOP (0.20.3) seems to ignore the C property on
Cfo:inlineE>.  If that's what it's meant to do, how do you set the
background color on part of a line?

=back

=head1 AUTHOR

Geoff Richards Eqef@laxan.comE

=head1 COPYRIGHT

Copyright 2002-2006, Geoff Richards.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl.

=cut

# vi:ts=3 sw=3 expandtab
Text-VimColor-0.11/README0000644000175000017500000000151110376145066013105 0ustar  qefqefText::VimColor
--------------

This module tries to markup text files according to their syntax.  It can
be used to produce web pages with pretty-printed colourful source code
samples.  It can produce output in the following formats:

The module comes with a command line program, text-vimcolor, which makes
it easy to do 'ad-hoc' syntax coloring jobs.


   Geoff Richards 


Release procedure
-----------------

 * Update the version number in lib/Text/VimColor.pm and META.yml
 * Update the changelog with a new section for a matching version number
   and the correct date and time
 * Copy the ChangeLog into place (from 'debian' directory in my CVS)
 * Realclean, make and test
 * Make the dist, take it to another machine and build and test there
 * Commit everything, and set tag like 'Release_0_07-1'
 * Upload to CPAN
Text-VimColor-0.11/Makefile.PL0000644000175000017500000000056510376144421014201 0ustar  qefqef#!/usr/bin/perl -w

use strict;
use ExtUtils::MakeMaker;

WriteMakefile(
   NAME => 'Text::VimColor',
   ABSTRACT_FROM => 'lib/Text/VimColor.pm',
   VERSION_FROM => 'lib/Text/VimColor.pm',
   AUTHOR => 'Geoff Richards ',
   NO_META => 1,
   EXE_FILES => [ 'text-vimcolor' ],

   PREREQ_PM => {
      'Path::Class' => 0.02,
   },
);

# vi:ts=3 sw=3 expandtab