home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / vile-src.zip / vile-8.1 / perl / syntax.pl < prev    next >
Text File  |  1998-10-01  |  5KB  |  137 lines
  1. # $Header: /usr/build/vile/vile/perl/RCS/syntax.pl,v 1.3 1998/10/01 10:29:26 tom Exp $
  2. #
  3. # See 'hilite.doc' for an overview.  This (with hilite.pl) provide a simple
  4. # syntax highlighting mode.
  5. #
  6. # Caveat: this is experimental code; the chief drawback is that it is slow.
  7. #
  8. # The following two lines need to be added to .vilerc
  9. #
  10. # ----------------------------------------
  11. # perl "Vile::register 'synon', 'synon', 'Syntax Hilighting, do', 'syntax.pl'"
  12. # perl "Vile::register 'synoff', 'synoff', 'Syntax Hilighting, undo', 'syntax.pl'"
  13. # ----------------------------------------
  14. #
  15. # this way :synon turns on hiliting and :synoff turns off hiliting.
  16. # (You must have a majormode defined, as well).
  17. #
  18. require 'hilite.pl';
  19. sub synon {
  20.     my $cb = $Vile::current_buffer;
  21.     my $mode = scalar($cb->get("majormode"));
  22.     return if (!defined($mode) || !length($mode));
  23.     my $syntaxer = "syntax$mode";
  24.     if (defined(&$syntaxer)) {
  25.         $cb->setregion(1,'$')->attribute("normal");
  26.         my $work = Vile::working(0);
  27.         print "[Syntax hiliting for $mode...]";
  28.         &$syntaxer($cb);
  29.         &syntax($cb);
  30.         print "[Syntax hiliting for $mode... done]";
  31.         Vile::working($work);
  32.         Vile::update;
  33.     } else {
  34.         print "[No syntax hilighting defined for $mode]"
  35.     }
  36. }
  37.  
  38. sub synoff {
  39.     my $cb = $Vile::current_buffer;
  40.     my $mode = scalar($cb->get("majormode"));
  41.     return if (!defined($mode) || !length($mode));
  42.     $cb->setregion(1,'$')->attribute("normal");
  43.     Vile::update;
  44. }
  45.  
  46. sub syntax {
  47.     my ($cb) = @_;
  48.     my (%kdata, $kdata, @kdot, $koff);
  49.     my (%mdata, $mdata, @mdot, $moff);
  50.     my (%rdata, $rdata, @rdot, $roff);
  51.     my ($line, $group, $l, @data, $pat, $start, $patt);
  52.     my ($save_line, $save_delim, $save_flag);
  53.  
  54.     %kdata = %syntax'kdata;
  55.     %mdata = %syntax'mdata;
  56.     %rdata = %syntax'rdata;
  57.  
  58.     # mangle the keyword lists into a regexp
  59.     foreach $kdata (keys %kdata) {
  60.         $kdata{$kdata}
  61.           = "(^|\\b)(" . join("|", split(/\s+/, $kdata{$kdata})) . ")(\\b|\$)";
  62.     }
  63.  
  64.     @data = <$cb>;
  65.     for ($l = 0; $l <= $#data; $l++) {
  66.         $save_line = $data[$l];
  67.  
  68.         @kdot = @mdot = ($l + 1, 0, $l + 1, 0);
  69.         foreach $group (@hilite) {
  70.             $line = $save_line;
  71.             next if (!defined $kdata{$group});
  72.             while ($line =~ m!$kdata{$group}!g) {
  73.                 $koff = pos($line);
  74.                 $kdot[3] = $koff;
  75.                 $kdot[1] = length($`);
  76.                 $cb->setregion(@kdot);
  77.                 $cb->attribute("normal");
  78.                 $cb->attribute(@{$hilite{$group}});
  79.             }
  80.         }
  81.         foreach $group (@hilite) {
  82.             next if (!defined @{$mdata{$group}});
  83.             foreach $mdata (@{$mdata{$group}}) {
  84.                 my ($pat, $hls, $hle) = @$mdata;
  85.                 $line = $save_line;
  86.                 while ($line =~ m!$pat!g) {
  87.                     $moff = pos($line);
  88.                     $mdot[3] = $moff + $hle;
  89.                     $mdot[1] = length($`) + $hls;
  90.                     $cb->setregion(@mdot);
  91.                     $cb->attribute("normal");
  92.                     $cb->attribute(@{$hilite{$group}});
  93.                 }
  94.             }
  95.         }
  96.     }
  97.     $save_delim = $/; $save_flag = $*;
  98.     $/ = ""; $* = 1;
  99.     $save_line = $cb->setregion(1,'$')->fetch;
  100.     foreach $group (@hilite) {
  101.         next if (!defined @{$rdata{$group}});
  102.         foreach $rdata (@{$rdata{$group}}) {
  103.             my ($rps, $rpe, $rskip, $hls, $hle) = @$rdata;
  104.             $line = $save_line; $l = 1; $start = 1;
  105.             $patt = $rps; @rdot = (1, 0);
  106.             while ($line =~ m!($patt|\n)!g) {
  107.  
  108.                 if ($& eq "\n") {
  109.                     ++$l;
  110.                     $line = substr($line, length($`)+1, length($line));
  111.                 } else {
  112.                     $roff = pos($line);
  113.                     if ( $start == 1 ) {
  114.                         $rdot[0] = $l;
  115.                         $rdot[1] = length($`) + $hls;
  116.                         $patt = $rpe;
  117.                         $start = 0;
  118.                     } elsif ( $start == 0 ) {
  119.                         next if ("$`$&" =~ m!${rskip}$!);
  120.                         $rdot[2] = $l;
  121.                         $rdot[3] = length($`) + $hle + 1;
  122.                         $cb->setregion(@rdot);
  123.                         $cb->attribute("normal");
  124.                         $cb->attribute(@{$hilite{$group}});
  125.                         $patt = $rps;
  126.                         $start = 1;
  127.                     }
  128.                 }
  129.             }
  130.         }
  131.     }
  132.     $/ = $save_delim; $* = $save_flag;
  133. }
  134.  
  135.  
  136. 1;
  137.