f90.st - enscript - GNU Enscript
(HTM) git clone git://thinkerwim.org/enscript.git
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) README
(DIR) LICENSE
---
f90.st (17021B)
---
1 /**
2 * Name: f90
3 * Description: Fortran90 programming language.
4 * Author: David Bowler <david.bowler@ucl.ac.uk>
5 *
6 * Copyright (C) 2009 Free Software Foundation, Inc.
7 */
8
9 /**
10 * Deal with strings enclosed with '...'
11 */
12 state f90_string_single extends Highlight
13 {
14 /[\']/ {
15 language_print ($0);
16 return;
17 }
18 LANGUAGE_SPECIALS {
19 language_print ($0);
20 }
21 }
22
23 /**
24 * Deal with strings enclosed with "..."
25 */
26 state f90_string_double extends Highlight
27 {
28 /[\"]/ {
29 language_print ($0);
30 return;
31 }
32 LANGUAGE_SPECIALS {
33 language_print ($0);
34 }
35 }
36
37 /**
38 * Deal function/subroutine declarations and subroutine calls: end with ) at end of line or then comment
39 */
40 state f90_func extends Highlight
41 {
42 /\)[ \t]*$/ {
43 language_print ($0);
44 return;
45 }
46 /(\)[ \t]*)(![a-zA-Z_0-9\,\.\(\)\*\%\: \t]*)/ {
47 language_print ($1);
48 comment_face (true);
49 language_print($2);
50 call (eat_one_line);
51 comment_face (false);
52 return;
53 }
54 LANGUAGE_SPECIALS {
55 language_print ($0);
56 }
57 }
58
59 /**
60 * Highlight variable declarations
61 */
62 state f90_new_var_list extends Highlight
63 {
64 /* Catch variable names followed by a comment: 1. Continuation marker present */
65 /([ \t]*::|[ \t]+)([a-zA-Z_0-9\,\.\(\)\*\%\: \t]+[^\&][ \t]*)(\&[ \t]*)(![a-zA-Z_0-9\,\.\(\)\*\%\: \t]*)/ {
66 language_print ($1);
67 variable_name_face(true);
68 language_print ($2);
69 language_print ($3);
70 variable_name_face(false);
71 comment_face (true);
72 language_print ($4);
73 call (eat_one_line);
74 comment_face (false);
75 }
76 /* Catch variable names followed by a comment: 2. No continuation marker (so return)*/
77 /([ \t]*::|[ \t]+)([a-zA-Z_0-9\,\.\(\)\*\%\: \t]+[^\&][ \t]*)(![a-zA-Z_0-9\,\.\(\)\*\%\: \t]*)/ {
78 language_print ($1);
79 variable_name_face(true);
80 language_print ($2);
81 variable_name_face(false);
82 comment_face (true);
83 language_print ($3);
84 call (eat_one_line);
85 comment_face (false);
86 return;
87 }
88 /* Is this a specifier ? 1. real(var) ? */
89 /(\([ \t]*)([a-zA-Z0-9_]+)([ \t]*\))/{
90 language_print($0);
91 }
92 /* Is this a specifier ? 2. real(kind=var) */
93 /(\([ \t]*)(len|kind)([a-zA-Z0-9_ =]+)(\))/{
94 language_print($1);
95 keyword_face(true);
96 language_print($2);
97 keyword_face(false);
98 language_print($3);
99 language_print($4);
100 }
101 /* Is this a specifier ? 3. real(kind=selected_real_kind(6,90)) */
102 /(\([ \t]*)(len|kind)([ \t]*=[ \t]*)(selected_(int_kind|real_kind))([ \t]*\([ \t]*[0-9\,]+[ \t]*\)[ \t]*)(\))/{
103 language_print($1);
104 keyword_face(true);
105 language_print($2);
106 keyword_face(false);
107 language_print($3);
108 keyword_face(true);
109 language_print($4);
110 keyword_face(false);
111 language_print($6);
112 language_print($7);
113 }
114 /* Highlight modifiers
115 (build-re '(allocatable Allocatable ALLOCATABLE external External EXTERNAL
116 intent Intent INTENT optional Optional OPTIONAL parameter Parameter PARAMETER pointer Pointer POINTER
117 private Private PRIVATE public Public PUBLIC save SAVE Save target TARGET Target))
118 */
119 /(\,[ \t]*)(A(LLOCATABLE|llocatable)|E(XTERNAL|xternal)|I(NTENT|ntent)\
120 |O(PTIONAL|ptional)\
121 |P(ARAMETER|OINTER|RIVATE|UBLIC|arameter|ointer|rivate|ublic)\
122 |S(AVE|ave)|T(ARGET|arget)|allocatable|external|intent|optional\
123 |p(arameter|ointer|rivate|ublic)|save|target)/ {
124 language_print($1);
125 keyword_face(true);
126 language_print($2);
127 keyword_face(false);
128 }
129 /(\,[ \t]*)(D(IMENSION|imension)|dimension)([ \t]*\([ \:\,\-+*a-zA-Z_0-9]+[ \t]*\))/ {
130 language_print($1);
131 keyword_face(true);
132 language_print($2);
133 keyword_face(false);
134 language_print($4);
135 }
136 /* Highlight variable names up to continuation marker */
137 /([ \t]*::|[^\,\(][ \t]*)([a-zA-Z_0-9]+[a-zA-Z_0-9\,\.\(\)\*\%\:\+\- \t]+[\&][ \t]*)$/ {
138 language_print ($1);
139 variable_name_face(true);
140 language_print ($2);
141 variable_name_face(false);
142 }
143 /* Highlight variable names up to end of line (no continuation marker: return) */
144 /([ \t]*::|[^\,\(][ \t]*)([a-zA-Z_0-9]+[a-zA-Z_0-9\,\.\(\)\*\%\:\+\- \t]*[^\&][ \t]*)$/ {
145 language_print ($1);
146 variable_name_face(true);
147 language_print ($2);
148 variable_name_face(false);
149 return;
150 }
151 /* Highlight variable names up to equals sign (return after equals)*/
152 /([ \t]*::|[^\,\(][ \t]*)([a-zA-Z_0-9]+[a-zA-Z_0-9\,\.\(\)\*\%\:\+\- \t]*[^\&])([ \t]*=)/ {
153 language_print ($1);
154 variable_name_face(true);
155 language_print ($2);
156 variable_name_face(false);
157 language_print ($3);
158 return;
159 }
160 LANGUAGE_SPECIALS {
161 language_print ($0);
162 }
163 }
164
165 /**
166 * Highlight F90 io statements
167 */
168 state f90_io extends Highlight
169 {
170 /* Catch comments */
171 /[!]/ {
172 comment_face (true);
173 language_print ($0);
174 call (eat_one_line);
175 comment_face (false);
176 }
177 /* String constants. */
178 /[\'][^\)]/ {
179 string_face (true);
180 language_print ($0);
181 call (f90_string_single);
182 string_face (false);
183 }
184 /[\"][^\)]/ {
185 string_face (true);
186 language_print ($0);
187 call (f90_string_double);
188 string_face (false);
189 }
190
191 /* This terminates an io statement */
192 /\)[^\'\"]/ {
193 language_print ($0);
194 return;
195 }
196
197 /* IO Keywords. (build-re '(FMT UNIT REC END ERR FILE STATUS
198 ACCESS FORM RECL BLANK IOSTAT EXIST OPENED NUMBER NAME
199 SEQUENTIAL DIRECT FORMATTED UNFORMATTED NEXTREC)) */
200 /\b(ACCESS|BLANK|DIRECT|E(ND|RR|XIST)|F(ILE|MT|ORM(|ATTED))|IOSTAT\
201 |N(AME|EXTREC|UMBER)|OPENED|REC(|L)|S(EQUENTIAL|TATUS)\
202 |UN(FORMATTED|IT))\b/ {
203 keyword_face (true);
204 language_print ($0);
205 keyword_face (false);
206 }
207
208 /* IO Keywords. (build-re '(fmt unit rec end err file
209 status access form recl blank iostat exist
210 opened number name sequential direct
211 formatted unformatted nextrec)) */
212 /\b((a|A)ccess|(b|B)lank|(d|D)irect|(e|E)(nd|rr|xist)|(f|F)(ile|mt|orm(|atted))|(i|I)ostat\
213 |(n|N)(ame|extrec|umber)|(o|O)pened|(r|R)ec(|l)|(s|S)(equential|tatus)\
214 |(u|U)n(formatted|it))\b/ {
215 keyword_face (true);
216 language_print ($0);
217 keyword_face (false);
218 }
219 LANGUAGE_SPECIALS {
220 language_print ($0);
221 }
222 }
223
224 state f90 extends HighlightEntry
225 {
226 BEGIN {
227 header ();
228 }
229 END {
230 trailer ();
231 }
232
233 /* String constants. */
234 /[\']/ {
235 string_face (true);
236 language_print ($0);
237 call (f90_string_single);
238 string_face (false);
239 }
240 /[\"]/ {
241 string_face (true);
242 language_print ($0);
243 call (f90_string_double);
244 string_face (false);
245 }
246 /* Labels - whitespace followed by number at start of line */
247 /^[ \t]*[0-9]+/{
248 keyword_face(true);
249 language_print ($0);
250 keyword_face(false);
251 }
252 /* Comments. We'll only have free-form, modern f90 statements - ! to end of line*/
253 /[!]/ {
254 comment_face (true);
255 language_print ($0);
256 call (eat_one_line);
257 comment_face (false);
258 }
259 /* builtins - maths, matrices etc */
260 /* Builtins.
261 (build-re '(abs achar acos adjustl adjustr aimag aint all allocated
262 anint any asin associated atan atan2 bit_size btest
263 ceiling char cmplx conjg cos cosh count cshift
264 date_and_time dble digits dim dot_product dprod eoshift
265 epsilon exp exponent floor fraction huge iachar iand
266 ibclr ibits ibset ichar ieor index int ior ishft
267 ishftc kind lbound len len_trim lge lgt lle llt log
268 logical log10 matmul max maxexponent maxloc maxval merge
269 min minexponent minloc minval mod modulo mvbits nearest
270 nint not pack precision present product radix
271 random_number random_seed range real repeat reshape
272 rrspacing scale scan selected_int_kind selected_real_kind
273 set_exponent shape sign sin sinh size spacing spread
274 sqrt sum system_clock tan tanh tiny transfer transpose
275 trim ubound unpack verify))
276 */
277 /\b((a|A)(bs|c(har|os)|djust(l|r)|i(mag|nt)|ll(|ocated)|n(int|y)|s(in|sociated)\
278 |tan(|2))\
279 |(b|B)(it_size|test)|(c|C)(eiling|har|mplx|o(njg|s(|h)|unt)|shift)\
280 |(d|D)(ate_and_time|ble|i(gits|m)|ot_product|prod)\
281 |(e|E)(oshift|psilon|xp(|onent))|(f|F)(loor|raction)|(h|H)uge\
282 |(i|I)(a(char|nd)|b(clr|its|set)|char|eor|n(dex|t)|or|shft(|c))|(k|K)ind\
283 |(l|L)(bound|en(|_trim)|g(e|t)|l(e|t)|og(|10|ical))\
284 |(m|M)(a(tmul|x(|exponent|loc|val))|erge|in(|exponent|loc|val)|od(|ulo)\
285 |vbits)\
286 |(n|N)(earest|int|ot)|(p|P)(ack|r(e(cision|sent)|oduct))\
287 |(r|R)(a(dix|n(dom_(number|seed)|ge))|e(al|peat|shape)|rspacing)\
288 |(s|S)(ca(le|n)|e(lected_(int_kind|real_kind)|t_exponent)|hape\
289 |i(gn|n(|h)|ze)|p(acing|read)|qrt|um|ystem_clock)\
290 |(t|T)(an(|h)|iny|r(ans(fer|pose)|im))|(u|U)(bound|npack)|(v|V)erify)\b/ {
291 builtin_face (true);
292 language_print ($0);
293 builtin_face (false);
294 }
295 /* Builtins.
296 (build-re '(ABS ACHAR ACOS ADJUSTL ADJUSTR AIMAG AINT ALL ALLOCATED
297 ANINT ANY ASIN ASSOCIATED ATAN ATAN2 BIT_SIZE BTEST
298 CEILING CHAR CMPLX CONJG COS COSH COUNT CSHIFT
299 DATE_AND_TIME DBLE DIGITS DIM DOT_PRODUCT DPROD EOSHIFT
300 EPSILON EXP EXPONENT FLOOR FRACTION HUGE IACHAR IAND
301 IBCLR IBITS IBSET ICHAR IEOR INDEX INT IOR ISHFT
302 ISHFTC KIND LBOUND LEN LEN_TRIM LGE LGT LLE LLT LOG
303 LOGICAL LOG10 MATMUL MAX MAXEXPONENT MAXLOC MAXVAL MERGE
304 MIN MINEXPONENT MINLOC MINVAL MOD MODULO MVBITS NEAREST
305 NINT NOT PACK PRECISION PRESENT PRODUCT RADIX
306 RANDOM_NUMBER RANDOM_SEED RANGE REAL REPEAT RESHAPE
307 RRSPACING SCALE SCAN SELECTED_INT_KIND SELECTED_REAL_KIND
308 SET_EXPONENT SHAPE SIGN SIN SINH SIZE SPACING SPREAD
309 SQRT SUM SYSTEM_CLOCK TAN TANH TINY TRANSFER TRANSPOSE
310 TRIM UBOUND UNPACK VERIFY))
311 */
312 /\b(A(BS|C(HAR|OS)|DJUST(L|R)|I(MAG|NT)|LL(|OCATED)|N(INT|Y)|S(IN|SOCIATED)\
313 |TAN(|2))\
314 |B(IT_SIZE|TEST)|C(EILING|HAR|MPLX|O(NJG|S(|H)|UNT)|SHIFT)\
315 |D(ATE_AND_TIME|BLE|I(GITS|M)|OT_PRODUCT|PROD)\
316 |E(OSHIFT|PSILON|XP(|ONENT))|F(LOOR|RACTION)|HUGE\
317 |I(A(CHAR|ND)|B(CLR|ITS|SET)|CHAR|EOR|N(DEX|T)|OR|SHFT(|C))|KIND\
318 |L(BOUND|EN(|_TRIM)|G(E|T)|L(E|T)|OG(|10|ICAL))\
319 |M(A(TMUL|X(|EXPONENT|LOC|VAL))|ERGE|IN(|EXPONENT|LOC|VAL)|OD(|ULO)\
320 |VBITS)\
321 |N(EAREST|INT|OT)|P(ACK|R(E(CISION|SENT)|ODUCT))\
322 |R(A(DIX|N(DOM_(NUMBER|SEED)|GE))|E(AL|PEAT|SHAPE)|RSPACING)\
323 |S(CA(LE|N)|E(LECTED_(INT_KIND|REAL_KIND)|T_EXPONENT)|HAPE\
324 |I(GN|N(|H)|ZE)|P(ACING|READ)|QRT|UM|YSTEM_CLOCK)\
325 |T(AN(|H)|INY|R(ANS(FER|POSE)|IM))|U(BOUND|NPACK)|VERIFY)\b/ {
326 builtin_face (true);
327 language_print ($0);
328 builtin_face (false);
329 }
330
331 LANGUAGE_SPECIALS {
332 language_print ($0);
333 }
334 /* Comparators. We have to roll by hand because of the
335 dots - "\b" doesn't delimit here. */
336 /\.((a|A)nd|(e|E)qv?|(g|G)(e|t)|(l|L)(e|t)|(n|N)e(qv)?|(n|N)ot|(o|O)r|(t|T)rue|(f|F)alse)\./ {
337 keyword_face (true);
338 language_print ($0);
339 keyword_face (false);
340 }
341
342 /* Comparators. We have to roll by hand because of the
343 dots - "\b" doesn't delimit here. */
344 /\.(AND|EQV?|G(E|T)|L(E|T)|NE(QV)?|NOT|OR|TRUE|FALSE)\./ {
345 keyword_face (true);
346 language_print ($0);
347 keyword_face (false);
348 }
349 /* function, subroutine declaration or subroutine call: 1. with arguments*/
350 /(^[ \t]*((c|C)all|(f|F)unction|(s|S)ubroutine)[ \t]+)([a-zA-Z_0-9]+)([ \t]*\()/ {
351 keyword_face(true);
352 language_print($1);
353 keyword_face(false);
354 function_name_face(true);
355 language_print($6);
356 function_name_face(false);
357 language_print($7);
358 call (f90_func);
359 }
360 /* function, subroutine declaration or subroutine call: 1. without arguments*/
361 /(^[ \t]*((c|C)all|(f|F)unction|(s|S)ubroutine)[ \t]+)([a-zA-Z_0-9]+[ \t]*)$/ {
362 keyword_face(true);
363 language_print($1);
364 keyword_face(false);
365 function_name_face(true);
366 language_print($6);
367 function_name_face(false);
368 language_print($7);
369 }
370 /* function, subroutine declaration or subroutine call*/
371 /((CALL|FUNCTION|SUBROUTINE)[ \t]+)([a-zA-Z_0-9]+)([ \t]*\()/ {
372 keyword_face(true);
373 language_print($1);
374 keyword_face(false);
375 function_name_face(true);
376 language_print($3);
377 function_name_face(false);
378 language_print($4);
379 call (f90_func);
380 }
381 /* end function, subroutine declaration or subroutine call*/
382 /(((e|E)nd)[ \t]*)(((c|C)all|(f|F)unction|(s|S)ubroutine)[ \t]+)([a-zA-Z_0-9]+)/ {
383 keyword_face(true);
384 language_print($1);
385 language_print($4);
386 keyword_face(false);
387 function_name_face(true);
388 language_print($9);
389 function_name_face(false);
390 }
391 /* end function, subroutine declaration or subroutine call*/
392 /((END)[ \t]*)((CALL|FUNCTION|SUBROUTINE)[ \t]+)([a-zA-Z_0-9]+)/ {
393 keyword_face(true);
394 language_print($1);
395 language_print($3);
396 keyword_face(false);
397 function_name_face(true);
398 language_print($5);
399 function_name_face(false);
400 }
401 /* Module, program, use declaration */
402 /(((e|E)nd)?[ \t]*)(((m|M)odule|(p|P)rogram|(u|U)se)[ \t]+)([a-zA-Z_0-9]+)/ {
403 keyword_face(true);
404 language_print($1);
405 language_print($4);
406 keyword_face(false);
407 function_name_face(true);
408 language_print($9);
409 function_name_face(false);
410 }
411 /* Module, program, use declaration */
412 /((END)?[ \t]*)((MODULE|PROGRAM|USE)[ \t]+)([a-zA-Z_0-9]+)/ {
413 debug(concat("Strings: ",$0));
414 debug(concat($1,"|"));
415 debug(concat($2,"|"));
416 debug(concat($3,"|"));
417 debug(concat($4,"|"));
418 debug(concat($5,"|"));
419 debug(concat($6,"|"));
420 keyword_face(true);
421 language_print($1);
422 language_print($3);
423 keyword_face(false);
424 function_name_face(true);
425 language_print($5);
426 function_name_face(false);
427 }
428 /* Function call */
429 /* Unfortunately, as F90 uses round brackets for function calls and arrays, this breaks */
430 /* /(=[ \t]*)([a-zA-Z_0-9]+)([ \t]*\()/{
431 language_print($1);
432 function_name_face(true);
433 language_print($2);
434 function_name_face(false);
435 language_print($3);
436 }*/
437 /* Variable declaration */
438 /^([ \t]*)((i|I)nteger|(r|R)eal|(c|C)omplex|(c|C)haracter|(l|L)ogical|([ \t]*(e|E)nd[ \t]*)?(t|T)ype)/ {
439 type_face(true);
440 language_print($0);
441 type_face(false);
442 call (f90_new_var_list);
443 }
444 /^([ \t]*)(INTEGER|REAL|COMPLEX|CHARACTER|LOGICAL|([ \t]*END[ \t]*)?TYPE)/ {
445 type_face(true);
446 language_print($0);
447 type_face(false);
448 call (f90_new_var_list);
449 }
450 /* none */
451 /\bnone\b/ {
452 type_face(true);
453 language_print($0);
454 type_face(false);
455 }
456 /* IO Statement (build-re '(open close read
457 write inquire backspace endfile rewind )) */
458 /\b((b|B)ackspace|(c|C)lose|(e|E)ndfile|(i|I)nquire|(o|O)pen|(r|R)e(ad|wind)|(w|W)rite)\b/ {
459
460 keyword_face (true);
461 language_print ($0);
462 keyword_face (false);
463 call (f90_io);
464 }
465
466 /* IO Statement (build-re '(OPEN CLOSE READ
467 WRITE INQUIRE BACKSPACE ENDFILE REWIND )) */
468 /\b(BACKSPACE|CLOSE|ENDFILE|INQUIRE|OPEN|RE(AD|WIND)|WRITE)\b/ {
469
470 keyword_face (true);
471 language_print ($0);
472 keyword_face (false);
473 call (f90_io);
474 }
475
476 /* Keywords */
477 /* (build-re '(allocate allocatable assign assignment block
478 case common contains
479 continue cycle data deallocate dimension do double else
480 elseif elsewhere end enddo endif entry equivalence
481 exit external forall format goto if implicit
482 include intent interface intrinsic module
483 namelist none nullify only operator optional parameter
484 pause pointer precision print private procedure program
485 public recursive result return save select
486 sequence stop subroutine target then use where
487 while))
488 */
489 /\b((a|A)(llocat(able|e)|ssign(|ment))|(b|B)lock\
490 |(c|C)(ase|o(mmon|nt(ains|inue))|ycle)|(d|D)(ata|eallocate|imension|o(|uble))\
491 |(e|E)(lse(|if|where)|n(d(|do|if)|try)|quivalence|x(it|ternal))\
492 |(f|F)or(all|mat)|(g|G)oto|(i|I)(f|mplicit|n(clude|t(e(nt|rface)|rinsic)))\
493 |(m|M)odule\
494 |(n|N)(amelist|ullify)|(o|O)(nly|p(erator|tional))\
495 |(p|P)(a(rameter|use)|ointer|r(ecision|i(nt|vate)|o(cedure|gram))|ublic)\
496 |(r|R)e(cursive|sult|turn)|(s|S)(ave|e(lect|quence)|top|ubroutine)\
497 |(t|T)(arget|hen)|(u|U)se|(w|W)h(ere|ile))\b/ {
498 keyword_face (true);
499 language_print ($0);
500 keyword_face (false);
501 }
502 /* (build-re '(ALLOCATE ALLOCATABLE ASSIGN ASSIGNMENT BLOCK
503 CASE COMMON CONTAINS
504 CONTINUE CYCLE DATA DEALLOCATE DIMENSION DO DOUBLE ELSE
505 ELSEIF ELSEWHERE END ENDDO ENDIF ENTRY EQUIVALENCE
506 EXIT EXTERNAL FORALL FORMAT GOTO IF IMPLICIT
507 INCLUDE INTENT INTERFACE INTRINSIC MODULE
508 NAMELIST NULLIFY ONLY OPERATOR OPTIONAL PARAMETER
509 PAUSE POINTER PRECISION PRINT PRIVATE PROCEDURE PROGRAM
510 PUBLIC RECURSIVE RESULT RETURN SAVE SELECT
511 SEQUENCE STOP SUBROUTINE TARGET THEN USE WHERE
512 WHILE))
513 */
514 /\b(A(LLOCAT(ABLE|E)|SSIGN(|MENT))|BLOCK\
515 |C(ASE|O(MMON|NT(AINS|INUE))|YCLE)|D(ATA|EALLOCATE|IMENSION|O(|UBLE))\
516 |E(LSE(|IF|WHERE)|N(D(|DO|IF)|TRY)|QUIVALENCE|X(IT|TERNAL))\
517 |FOR(ALL|MAT)|GOTO|I(F|MPLICIT|N(CLUDE|T(E(NT|RFACE)|RINSIC)))\
518 |MODULE\
519 |N(AMELIST|ULLIFY)|O(NLY|P(ERATOR|TIONAL))\
520 |P(A(RAMETER|USE)|OINTER|R(ECISION|I(NT|VATE)|O(CEDURE|GRAM))|UBLIC)\
521 |RE(CURSIVE|SULT|TURN)|S(AVE|E(LECT|QUENCE)|TOP|UBROUTINE)\
522 |T(ARGET|HEN)|USE|WH(ERE|ILE))\b/ {
523 keyword_face (true);
524 language_print ($0);
525 keyword_face (false);
526 }
527 LANGUAGE_SPECIALS {
528 language_print ($0);
529 }
530 }
531
532
533
534 /*
535 Local variables:
536 mode: c
537 End:
538 */