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