/************************************************************************ * f90.e * * "Epsilon" is a registered trademark licensed to Lugaru Software, Ltd. * * "EEL" and "Lugaru" are trademarks of Lugaru Software, Ltd. * * * * Copyright (C) 1996, 1997 Lugaru Software Ltd. All rights reserved. * * * * Limited permission is hereby granted to reproduce and modify this * * copyrighted material provided that the resulting code is used only in * * conjunction with Lugaru products and that this notice is retained in * * any such reproduction or modification. * * *********************************************************************** * Modified by Vivek Rao, Jan 14, 1998 email:bukic@aol.com * * Modified the assembly language eel (asm.e) program * * from the lugaru web site * * Provides syntax highlighting for Fortran 95 programs * * Highlights the f90 keywords in blue. * * Comments are in green and strings are in red. * *********************************************************************** */ #include "eel.h" #include "proc.h" #include "colcode.h" char _f90_mode_name[] = "f90"; /* f90 mode */ keytable f90_tab; /* key table for f90 mode */ color_scheme "standard-gui" { /* define some of the colors */ color_class f90_keyword blue; color_class f90_unit grey; color_class f90_single red; color_class f90_type dark_magenta; color_class f90_array dark_green; color_class f90_identifier black; color_class f90_comment magenta; }; color_f90_range(from, to) // recolor just this section { // last colored region may go past to int t = -1, talk, s; if (from >= to) return to; save_var point, matchstart, matchend; c_init_color(from, to); point = from; talk = (to - from > 2000); // show status during long delays save_var case_fold = 0; while (point < to) { if (!re_search(1, "[0-9A-Za-z_.]+|[\"';#!]")) { t = size(); break; } t = matchstart; switch (character(point - 1)) { // check last char case '!': // found a ! sign (starts a comment) nl_forward(); set_character_color(t, point, color_class f90_comment); break; case '"': // found a string literal point = t; re_search(1, "\"([^\"\\\n]|\\(.|\n))*[\"\n]"); set_character_color(t, point, color_class c_string); if (get_character_color(point, (int *) 0, &s) == color_class c_string && s > to) // fix up after c_init_color(point, to = s); // quoted "'s break; default: // found identifier, kywd, or number set_character_color(t, point, f90_keyword_color(t)); // set_character_color(t, point, f90_unit_color(t)); // I cannot define two separate colors for units and other keywords. break; } if (talk) note("Coloring f90 program: %d%% complete...", (point - from) * 100 / (to - from)); } c_init_color(to, t); if (talk) note(""); return point; } f90_keyword_color(from) // return color for "identifier" from here to point { // (something with alpha or digits) char buf[500]; if (point - from > sizeof(buf) - 10) save_var point = from + sizeof(buf) - 10; buf[0] = '|'; // get identifier, between | chars grab(from, point, buf + 1); if (buf[1] == '.' && index("0123456789", buf[2]) || index("0123456789-", buf[1])) return c_number_color(buf + 1); strcpy(buf + point - from + 1, "|"); if (is_f90_keyword(buf)) return color_class f90_keyword; if (is_f90_unit(buf)) return color_class f90_unit; if (is_f90_single(buf)) return color_class f90_single; if (is_f90_type(buf)) return color_class f90_type; if (is_f90_array(buf)) return color_class f90_array; return color_class f90_identifier; } f90_unit_color(from) // return color for "identifier" from here to point { // (something with alpha or digits) char buf[500]; if (point - from > sizeof(buf) - 10) save_var point = from + sizeof(buf) - 10; buf[0] = '|'; // get identifier, between | chars grab(from, point, buf + 1); if (index("0123456789-.", buf[1])) return c_number_color(buf + 1); strcpy(buf + point - from + 1, "|"); if (is_f90_unit(buf)) return color_class f90_unit; return color_class f90_identifier; } // Fortran 95 keyword list is_f90_keyword(p) // is text in p (must be surrounded by |'s) a keyword? char *p; { if (strstr("|if|else|while|select|" "|do|break|" "|continue|exit|" "|print|" "|int|" "|iostat|forall|form|len|recl|position|" "|close|.true.|.false.|elemental|pure|recursive|file|action|status|access|" "|type|name|dimension|inquire|unit|fmt|exist|opened|number|named|name|sequential|" "|direct|formatted|unformatted|recl|nextrec|readwrite|advance|backspace|endfile|" "|rewind|" "|end|allocate|write|read|allocate|open|then|to|format|result|.and.|.or.|" // reserved names listed in Appendix C of "Programmer's Guide to F, by Brainerd, Goldberg, and Adams" "|achar|assignment|cpu_time|dble|deallocate|default|dim|dprod|where|elsewhere|" // the following words are F reserved names but I prefer not to use them (I use two words) and so do not color them // uncomment line below to color: // "|enddo|endfile|endforall|endfunction|endif|endinterface|endmodule|endprogram|endsubroutine|" // "|endtype|endwhere| // some intrinsic functions, taken from the listing in "Essential Lahey Fortran 90 manual, revision C" "|abs|achar|acos|adjustl|adjustr|aimag|aint|all|allocate|allocated|anint|asin|associated|" "|atan|atan2|backspace|bit_size|btest|ceiling|char|cmplx|conjg|cos|cosh|count|cshift|" "|iachar|lge|lgt|lle|llt|date_and_time|deallocate|digits|dim|dot_product|eoshift|epsilon|exp|" "|exponent|floor|fraction|huge|iand|ibclr|ibits|ibset|ichar|ieor|index|delim|pad|ior|ishft|" "|ishftc|kind|lbound|len|len_trim|lge|lgt|lle|llt|log|log10|matmul|max|maxexponent|maxloc|" "|maxval|merge|min|minexponent|minloc|minval|mod|modulo|mvbits|namelist|nearest|nint|nullify|" "|open|pack|unpack|precision|product|radix|random_number|random_seed|range|read|repeat|reshape|" "|rrspacing|scale|scan|selected_int_kind|selected_real_kind|sequence|set_exponent|shape|" "|sign|sin|sinh|size|spacing|spread|sqrt|sum|system_clock|tan|tanh|tiny|transfer|transpose|" "|trim|ubound|verify|" ,p)) return 1; return 0; } is_f90_unit(p) // is text in p (must be surrounded by |'s) a keyword? char *p; { // program units and keywords used to specify them if (strstr("|program|procedure|operator|function|module|subroutine|interface|contains|",p)) return 1; return 0; } is_f90_single(p) // is text in p (must be surrounded by |'s) a keyword? char *p; { // keywords which affect program control if (strstr("|use|stop|cycle|exit|return|pause|call|",p)) return 1; return 0; } is_f90_type(p) // is text in p (must be surrounded by |'s) a keyword? char *p; { // data types and attributes if (strstr("|public|private|present|optional|integer|real|complex|character|doubleprecision|implicit|logical|parameter|target|save|allocatable|pointer|none|intent|",p)) return 1; return 0; } is_f90_array(p) // is text in p (must be surrounded by |'s) a keyword? char *p; { if (strstr("|Dot_Product|size|sum|product|size|shape|mask|maxval|minval|matmul|Matmul|all|any|",p)) return 1; return 0; } // A recolor_from_here function good for line-based buffers. recolor_by_lines(safe) { safe = safe; // eliminate compiler warning return give_begin_line(); } command f90_mode() { mode_keys = f90_tab; /* Use these keys. */ major_mode = _f90_mode_name; // strcpy(comment_start, "#"); // regex for start of comment strcpy(comment_start, "!"); // regex for start of comment strcpy(comment_pattern, ".*!.*$"); // regex pattern for comment area strcpy(comment_begin, "! "); // string used if epsilon automatically creates comment strcpy(comment_end, ""); // string used to indicate end of string recolor_range = color_f90_range; // set up coloring rules recolor_from_here = recolor_by_lines; if (want_code_coloring) // maybe turn on coloring when_setting_want_code_coloring(); try_calling("f90-mode-hook"); make_mode(); } suffix_f90() { f90_mode(); }