1 rizwank 1.1 /**
  2              * Name: perl
  3              * Description: Perl programming language.
  4              *
  5              * Author: Jim Villani, Logistics Management Institute (jvillani@lmi.org)
  6              *         perl_pod mods by Gregor Purdy (gregor@focusresearch.com)
  7              */
  8             
  9             state perl_pod extends Highligth
 10             {
 11               /\\\\./ {
 12                 language_print ($0);
 13               }
 14               /^=cut\s*$/ {
 15                 language_print ($0);
 16                 return;
 17               }
 18             }
 19             
 20             state perl_comment extends Highlight
 21             {
 22 rizwank 1.1   /\*\\\// {
 23                 language_print ($0);
 24                 return;
 25               }
 26             }
 27             
 28             state perl_dquot_string extends Highlight
 29             {
 30               /\\\\./ {
 31                 language_print ($0);
 32               }
 33               /\"/ {
 34                 language_print ($0);
 35                 return;
 36               }
 37             }
 38             
 39             state perl_quot_string extends Highlight
 40             {
 41               /\\\\./ {
 42                 language_print ($0);
 43 rizwank 1.1   }
 44               /[\']/ {
 45                 language_print ($0);
 46                 return;
 47               }
 48             }
 49             
 50             state perl_bquot_string extends Highlight
 51             {
 52               /\\\\./ {
 53                 language_print ($0);
 54               }
 55               /`/ {
 56                 language_print ($0);
 57                 return;
 58               }
 59             }
 60             
 61             state perl extends HighlightEntry
 62             {
 63               /* Comments. */
 64 rizwank 1.1   /#.*$/ {
 65                 comment_face (true);
 66                 language_print ($0);
 67                 comment_face (false);
 68               }
 69             
 70               /* Ignore escaped quote marks */
 71               /\\\"/ {
 72                 language_print ($0);
 73               }
 74               /\\\'/ {
 75                 language_print ($0);
 76               }
 77               /\\\`/ {
 78                 language_print ($0);
 79               }
 80             
 81               /* stuff after a -> is a method,
 82                * don't bold just because it looks like a keyword
 83                */
 84               /->\w+/ {
 85 rizwank 1.1     language_print ($0);
 86               }
 87             
 88               /* stuff between a - and a => is a named parameter,
 89                * don't bold just because it looks like a keyword
 90                */
 91               /-\w+=>/ {
 92                 language_print ($0);
 93               }
 94             
 95               /* In cgi files, JavaScript might be embedded, so we need to look out
 96                * for the JavaScript comments, because they might contain something
 97                * we don't like, like a contraction (don't, won't, etc.)
 98                * We won't put them in comment face, because they are not perl
 99                * comments.
100                */
101               /\/\// {
102                 language_print ($0);
103                 call (eat_one_line);
104               }
105             
106 rizwank 1.1   /* String constants. */
107               /\"/ {
108                 string_face (true);
109                 language_print ($0);
110                 call (perl_dquot_string);
111                 string_face (false);
112               }
113               /[\']/ {
114                 string_face (true);
115                 language_print ($0);
116                 call (perl_quot_string);
117                 string_face (false);
118               }
119             
120               /* Backquoted command string */
121               /`/ {
122                 string_face (true);
123                 language_print ($0);
124                 call (perl_bquot_string);
125                 string_face (false);
126               }
127 rizwank 1.1 
128               /* Variables */
129               /[$%@&]+\w+/ {
130                 keyword_face (false);
131                 language_print ($0);
132               }
133             
134               /* Keywords. From perl distribution's toke.c
135                  abs accept alarm and atan2 bind binmode bless caller chdir chmod
136                  chomp chop chown chr chroot close closedir cmp connect continue cos
137                  crypt dbmclose dbmopen defined delete die do dump each else elsif
138                  endgrent endhostent endnetent endprotoent endpwent endservent eof
139                  eq eval exec exists exit exp fcntl fileno flock for foreach fork
140                  format formline ge getc getgrent getgrgid getgrnam gethostbyaddr
141                  gethostbyname gethostent getlogin getnetbyaddr getnetbyname
142                  getnetent getpeername getpgrp getppid getpriority getprotobyname
143                  getprotobynumber getprotoent getpwent getpwnam getpwuid getservbyname
144                  getservbyport getservent getsockname getsockopt glob gmtime goto
145                  grep gt hex if index int ioctl join keys kill last lc lcfirst le
146                  length link listen local localtime log lstat lt m map mkdir msgctl
147                  msgget msgrcv msgsnd my ne new next no not oct open opendir or ord
148 rizwank 1.1      pack package pipe pop pos print printf prototype push q qq quotemeta
149                  qw qx rand read readdir readline readlink readpipe recv redo ref
150                  rename require reset return reverse rewinddir rindex rmdir s scalar
151                  seek seekdir select semctl semget semop send setgrent sethostent
152                  setnetent setpgrp setpriority setprotoent setpwent setservent
153                  setsockopt shift shmctl shmget shmread shmwrite shutdown sin sleep
154                  socket socketpair sort splice split sprintf sqrt srand stat study
155                  sub substr symlink syscall sysopen sysread sysseek system syswrite
156                  tell telldir tie tied time times tr truncate uc ucfirst umask undef
157                  unless unlink unpack unshift untie until use utime values vec wait
158                  waitpid wantarray warn while write x xor y
159                */
160               /\b(a(bs|ccept|larm|nd|tan2)|b(in(d|mode)|less)|c(aller|h(dir|mod\
161             |o(mp|p|wn)|r(|oot))|lose(|dir)|mp|o(n(nect|tinue)|s)|rypt)\
162             |d(bm(close|open)|e(fined|lete)|ie|o|ump)|e(ach|ls(e|if)|nd(gr|host|net|proto\
163             |pw|serv)ent|of|q|val|x(ec|i(sts|t)|p))|f(cntl|ileno|lock|or(|each|k\
164             |m(at|line)))|g(e(|t(c|gr(ent|gid|nam)|host(by(addr|name)|ent)|login\
165             |net(by(addr|name)|ent)|p(eername|grp|pid|riority|roto(by(addr|name|number)\
166             |ent)|w(ent|nam|uid))|s(erv(by(name|port)|ent)|ock(name|opt))))|lob|mtime\
167             |oto|rep|t)|hex|i(f|n(t|dex)|octl)|join|k(eys|ill)|l(ast|c(|first)|e(|ngth)\
168             |i(nk|sten)|o(cal(|time)|g)|stat|t)|m|m(ap|kdir|sg(ctl|get|rcv|snd)|y)\
169 rizwank 1.1 |n(e(|w|xt)|o(|t))|o(ct|pen(|dir)|r(|d))|p(ack(|age)|ipe|o(p|s)|r(int(|f)\
170             |ototype)|ush)|q(|q|uotemeta|w|x)|r(and|e(a(d(|dir|lin(e|k)|pipe))|cv\
171             |do|f|name|quire|set|turn|verse|winddir)|index|mdir)|s(|calar|e(e(k|kdir)\
172             |lect|m(ctl|get|op)|nd|t((gr|host|net)ent|p(grp|r(iority|otoent)|went)\
173             |s(ervent|ockopt)))|h(ift|m(ctl|get|read|write)|utdown)|in|leep|o(cke(t|tpair)\
174             |rt)|p(li(ce|t)|rintf)|qrt|rand|t(at|udy)|u(b|bstr)|y(mlink|s(call|open|read\
175             |s(eek|tem)|write)))|t(ell(|dir)|i(e|ed|m(e|es))|r(|uncate))|u(c(|first)\
176             |mask|n(def|l(ess|ink)|pack|shift|ti(e|l))|se|time)|v(alues|ec)|w(a(i(t(|pid))\
177             |ntarray|rn)|hile|rite)|x(|or)|y)\b/ {
178             
179                 keyword_face (true);
180                 language_print ($0);
181                 keyword_face (false);
182               }
183             
184               /* POD. */
185               /^=(pod|head1|head2|item|over|back|for|begin|end)\b.*$/ {
186                 language_print ($0);
187                 call (perl_pod);
188               }
189             }
190 rizwank 1.1 
191             
192             /*
193             Local variables:
194             mode: c
195             End:
196             */