home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / vile-src.zip / vile-8.1 / perl / hilite.pl < prev    next >
Text File  |  1998-10-01  |  6KB  |  174 lines
  1. # $Header: /usr/build/vile/vile/perl/RCS/hilite.pl,v 1.2 1998/10/01 10:10:23 tom Exp $
  2. #
  3. # See syntax.pl (and hilite.doc).
  4. #
  5. @hilite = ('todo', 'variable',  'special',  'identifier',
  6.            'type', 'preproc', 'error', 'statement', 'constant', 'comment');
  7.  
  8. %hilite = ("comment"    => [ "color", "04" ],
  9.            "constant"   => [ "color", "06" ],
  10.            "identifier" => [ "color", "02", "bold" ],
  11.            "statement"  => [ "color", "03" ],
  12.            "preproc"    => [ "color", "05" ],
  13.            "type"       => [ "color", "14" ],
  14.            "special"    => [ "color", "01" ],
  15.            "error"      => [ "color", "11" ],
  16.            "todo"       => [ "color", "12" ],
  17.            "variable"   => [ "color", "13" ]);
  18.  
  19. sub syntaxperl {
  20.  
  21.     $syntax'kdata{statement} =
  22.       "foreach for if while return next last exit do until unless sub "
  23.     . "elsif else eq ne gt lt ge le cmp";
  24.  
  25.     $syntax'kdata{identifier} =
  26.       "abs  accept  alarm atan2 bind binmode bless caller chdir chmod chomp "
  27.     . "chop  chown  chr  chroot  closedir  close connect continue cos crypt "
  28.     . "dbmclose  dbmopen  defined  delete die dump each endgrent endhostent "
  29.     . "endnetent  endprotoent  endpwent  endservent  eof  eval  exec exists "
  30.     . "exp  fcntl  fileno  flock  fork  format formline getc getgrent "
  31.     . "getgrgid  getgrnam  gethostbyaddr  gethostbyname gethostent getlogin "
  32.     . "getnetbyaddr  getnetbyname  getnetent  getpeername  getpgrp  getppid "
  33.     . "getpriority  getprotobyname  getprotobynumber  getprotoent  getpwent "
  34.     . "getpwnam    getpwuid    getservbyname    getservbyport    getservent "
  35.     . "getsockname  getsockopt  glob  gmtime goto grep hex import index int "
  36.     . "ioctl  join  keys  kill  lcfirst  lc  length link listen local "
  37.     . "localtime  log  lstat  map mkdir msgctl msgget msgrcv msgsnd my "
  38.     . "no  oct  opendir  open  ord  package  pack pipe pop pos printf print "
  39.     . "push  quotemeta  rand  readdir  read  readlink  recv redo ref rename "
  40.     . "require  reset  reverse rewinddir rindex rmdir scalar seekdir "
  41.     . "seek  select  semctl semget semop send setgrent sethostent setnetent "
  42.     . "setpgrp   setpriority  setprotoent  setpwent  setservent  setsockopt "
  43.     . "shift  shmctl  shmget  shmread  shmwrite  shutdown  sin sleep socket "
  44.     . "socketpair  sort  splice  split  sprintf  sqrt  srand stat study "
  45.     . "substr  symlink  syscall  sysread  system  syswrite telldir tell tie "
  46.     . "time  times  truncate  ucfirst  uc umask undef unlink unpack unshift "
  47.     . "untie  use  utime values vec wait waitpid wantarray warn write";
  48.  
  49.     %syntax'mdata = (
  50.         "comment" => [
  51.             [ '^\s*#.*$', 0, 0 ],
  52.         ],
  53.         "special" => [
  54.             [ 'proc \S+', 5, 0 ],
  55.         ],
  56.         "variable" => [
  57.             [ '[\$@%\&][\w:]+', 0, 0 ],
  58.             [ '<[^>]*>', 1, -1],
  59.         ],
  60.         "special" => [
  61.             [ 'sub \S+', 4, 0 ],
  62.         ],
  63.         "constant" => [
  64.             [ '-?\d+[.\d]*', 0, 0 ],
  65.         ],
  66.     );
  67.  
  68.     %syntax'rdata = (
  69.         "constant" => [
  70.             [ '"', '"', '\\"', 1, -1 ],
  71.             [ '\'', '\'', '\\\'', 1, -1 ],
  72.         ],
  73.     );
  74. }
  75.  
  76. sub syntaxtcl {
  77.  
  78.     $syntax'kdata{statement} =
  79.       "foreach for if case switch while return break continue exit "
  80.     . "uplevel source proc global upvar error catch bgerror unknown "
  81.     . "for_array_keys for_recursive_glob loop else elseif";
  82.  
  83.     $syntax'kdata{identifier} =
  84.       "cd after append close concat eof exec linsert format gets "
  85.     . "glob incr join lappend lindex list llength lrange lreplace lsearch "
  86.     . "lsort open pid puts pwd read regexp regsub scan seek socket split "
  87.     . "subst tell time vwait popd pushd recursive_glob showproc alarm chgrp "
  88.     . "chmod chown convertclock execl fmtclock chroot fork getclock kill link "
  89.     . "mkdir nice rmdir sleep system sync times umask unlink wait bsearch dup "
  90.     . "copyfile fcntl flock funlock fstat lgets frename pipe read_file select "
  91.     . "write_file scancontext scanfile scanmatch abs ceil double exp floor "
  92.     . "fmod pow round sqrt max min random intersect intersect3 lassign lempty "
  93.     . "lmatch lrmdups lvarcat lvarpop lvarpush union keyldel keylget keylkeys "
  94.     . "cequal cindex clength crange csubstr ctoken keylset cexpand ctype "
  95.     . "expr eval set unset rename replicate translit array clock file history "
  96.     . "trace infox id signal info string";
  97.  
  98.     %syntax'mdata = (
  99.         "comment" => [
  100.             [ '^\s*#.*$', 0, 0 ],
  101.             [ '\;#.*$'  , 1, 0 ],
  102.         ],
  103.         "special" => [
  104.             [ 'proc \S+', 5, 0 ],
  105.         ],
  106.     );
  107.  
  108.     %syntax'rdata = (
  109.         "constant" => [
  110.             [ '"', '"', '\\\\"', 1, -1 ],
  111.         ],
  112.     );
  113. }
  114.  
  115. sub syntaxc {
  116.  
  117.     $syntax'kdata{type} =
  118.       "void register short enum extern int struct static long char unsigned "
  119.     . "double float volatile union auto class friend protected private public "
  120.     . "const mutable virtual inline inherited enum";
  121.  
  122.     $syntax'kdata{statement} =
  123.       "for if else while catch throw operator asm this continue break switch "
  124.     . "case delete default goto return exit";
  125.  
  126.     $syntax'kdata{preproc} =
  127.       "#ifdef #ifndef #if #endif #define #include";
  128.  
  129.     %syntax'mdata = (
  130.         "comment" => [
  131.             [ '//.*$', 0, 0 ],
  132.         ],
  133.         "constant" => [
  134.             [ '\b\.?[\d]+\b', 0, 0 ],
  135.         ],
  136.     );
  137.  
  138.     %syntax'rdata = (
  139.         "constant" => [
  140.             [ '"', '"', '\\\\"', 1, -1 ],
  141.         ],
  142.         "comment" => [
  143.             [ '/\*', '\*/', undef, 0, 0 ],
  144.         ],
  145.     );
  146. }
  147.  
  148. sub syntaxmail {
  149.     my ($cb) = @_;
  150.     my $line = 1;
  151.     $cb->dot('$$');
  152.     $last = scalar($cb->dot)-1;
  153.     $cb->set_region(1,'$$');
  154.     while (<$cb>) {
  155.         last if $_ eq "\n";
  156.         $line++;
  157.     }
  158.     $cb->set_region(1,$line)->attribute("bold");
  159.     $cb->set_region($line,'$$');
  160.  
  161.     while (<$cb>) {
  162.         if (/^[>\s]*$/) {
  163.             $cb->set_region($line,0,$line,'$')->delete;
  164.         } elsif (/^[>\s]*>/) {
  165.             $cb->set_region($line,$line)->attribute('color'=>length($&)%16);
  166.         }
  167.         $cb->set_region(++$line,'$');
  168.         last if ($line >= $last);
  169.     }
  170.     $cb->dot(0,0);
  171. }
  172.  
  173. 1;
  174.