/* * Miscellaneous QEmacs modes for Forth variants * * Copyright (c) 2014 Charlie Gordon. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ #include "qe.h" /* XXX: should have different flavors of Forth: * FreeForth, ficl, gforth... */ /*---------------- Free Forth language coloring ----------------*/ char const ff_keywords[] = { "|rst|>SC|SC|>S1|>S0|>C1|>C0|c04|s09|s08|s01|s1|,3`|,4`|,2`|,1`" "|here`|allot`|align`|,`|w,`|c,`|swap`|2dup`|dup`|nipdup`|tuck`" "|over`|under`|pick`|2drop`|drop`|nip`|rot`|-rot`|>rswapr>`|depth" "|>r`|2>r`|dup>r`|r>`|2r>`|dropr>`|r`|2r`|rdrop`|2rdrop`|rp@`|sp@`" // |` requires a different separator "|over&`|over|`|over^`|2dup+`|over+`|over-`|over*`|&`|^`|+`|-`|*`|/`|%`" "|~`|negate`|bswap`|flip`|invert|not|and|or|xor|mod|1-`" "|1+`|2+`|4+`|2*`|2/`|4*`|4/`|8*`|8/`|<<`|>>`|m/mod`|/%`|min`|max`" "|within|bounds`|@`|c@`|w@`|2@`|dup@`|dupc@`|dupw@`|@+`|c@+`|w@+`" "|!`|c!`|w!`|2!`|+!`|-!`|over!`|overc!`|overw!`|over+!`|over-!`" "|tuck!`|tuckc!`|tuckw!`|tuck+!`|tuck-!`|2dup!`|2dupc!`|2dupw!`" "|2dup+!`|2dup-!`|on`|off`|erase|fill|move|cmove`|place`|$-|search" "|lit`|'`|-call|call,|callmark|;;`|tailrec|anon:`|anon|;`|[`|]`" "|H|header|find|which|>in|tp|tib|eob|\\`|(`|EOF`|parse|wsparse|lnparse" "|compiler|number|notfound|classes|:`|alias`|create`|variable`|constant`" "|equ`|:^`|^^`|!^`|@^`|execute|reverse`|catch|throw|:|;|?" "|+longconds`|-longconds`|?`|0>`|0<=`|0>=`|0<`|0<>`|0=`|C1?`|C0?`" "|0-`|`?1|`?#|<>`|=`|>`|<=`|>=`|<`|u>`|u<=`|u>=`|u<`|`?2|BOOL`" "|nzTRUE|zFALSE|`?off|`cond|IF`|CASE`|ELSE`|SKIP`|THEN`|;THEN`" "|BEGIN`|`mrk|TIMES`|RTIMES`|START`|ENTER`|0;`|TILL`|WHILE`|AGAIN`" "|BREAK`|END`|UNTIL`|REPEAT`|if`|0=if`|0=if`|=if`|<>if`|df|df>f|f>s|s>f|`f:`|finit`|fpi`" "|1.`|0.`|fdup`|fover`|fdrop`|fnip`|fswap`|f2drop`|f2dup`|ftuck`" "|funder`|frot`|f-rot`|fmax`|fmin`|fabs`|fnegate`|f+`|fover+`|f-`" "|fover-`|fswap-`|f*`|fover*`|f/`|fover/`|fswap/`|f1/`|`fscale`" "|`fxtract`|f2/|f2*|`fldln2|`fldlg2|`fldl2e|`fldl2t|`fxl2y|`fxl2yp1" "|`f2xm1|fln`|flog`|f**|faln|falog|fsqrt`|sqrt|fsinh|fcosh|ftanh" "|fasinh|facosh|fatanh|fsin`|fcos`|ftan`|fsincos`|fasin|facos" "|fatan`|fatan2`|f0<`|f0>=`|f0<>`|f0=`|f0<=`|f0>`|`f?1|f<`|f>=`" "|f<>`|f=`|f<=`|f>`|`f?2|f~|f@`|dupf@`|f+!`|f!`|dupf!`|f,`|fvariable`" "|flit`|fconstant`|f#|f.|f.s`|fnumber|uart!|port!|.ports`|COM" "|bps|.bps`|noParity|oddParity|evenParity|DSR?|CTS?|RI?|CD?" "|RTS0|RTS1|DTR0|DTR1|UBREAK|RX|RX?|key?|TX|XRECV|XSEND" "|dumpterm|dumbterm|utrace" "|" }; enum { FF_STYLE_TEXT = QE_STYLE_DEFAULT, FF_STYLE_COMMENT = QE_STYLE_COMMENT, FF_STYLE_KEYWORD = QE_STYLE_KEYWORD, FF_STYLE_STRING = QE_STYLE_STRING, FF_STYLE_NUMBER = QE_STYLE_NUMBER, }; enum { IN_FF_TRAIL = 1, /* beyond EOF directive */ IN_FF_COMMENT = 2, /* multiline comment ( ... ) */ }; static int ff_convert_date(int year, int month, int day) { /* convert date to generalized gregorian day number */ int gday = 0; if (year >= 0 && month > 0) { static int const elapsed_days[12] = { 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, }; int mm = month - 1; int yy = year + mm / 12; mm %= 12; yy -= 1; gday = year * 365 + yy / 4 - yy / 100 + yy / 400; gday += elapsed_days[mm]; if (year % 4 == 0 && (year % 100 != 0 || year % 400 == 0) && mm > 1) gday += 1; gday += day - 60; /* starting on 1/3/0000 */ } return gday; } static int ff_match_number(const char *str, int *pnum) { int i = 0, base = 10, c, digit; int year = -1, month = -1; long long num = 0, stash = 0; if (str[i] == '-') { i++; if (str[i] == '\0') return 0; } for (; (c = str[i]) != '\0'; i++) { switch (c) { case '\'': continue; case '$': base = 16; continue; case '&': base = 8; continue; case '%': base = 2; continue; case '#': base = num; num = 0; continue; case ':': if (i == 0) break; stash = (stash + num) * 60; num = 0; continue; case '_': if (i == 0) break; if (year >= 0 && month >= 0) { num = ff_convert_date(year, month, num); num = 0; year = month = -1; } stash = (stash + num) * 24; num = 0; continue; case '-': if (i == 0) break; if (year < 0) year = num; else month = num; num = 0; continue; default: if (c >= '0' && c <= '9') digit = c - '0'; else if (c >= 'a' && c <= 'z') digit = c - 'a' + 10; else if (c >= 'A' && c <= 'Z') digit = c - 'A' + 10; else digit = 255; if (digit >= base) break; num = num * base + digit; continue; } break; } if (year >= 0 && month >= 0) { stash = ff_convert_date(year, month, num); num = 0; } num += stash; if (i > 0 && str[i] == '\0') { if (pnum) *pnum = (*str == '-') ? -num : num; return i; } return 0; } static void ff_colorize_line(QEColorizeContext *cp, unsigned int *str, int n, ModeDef *syn) { char word[64]; int i = 0, start = 0, c, num = 0, len, numlen, colstate = cp->colorize_state; if (colstate & IN_FF_TRAIL) goto comment; if (str[0] == '#' && str[1] == '!') goto comment; for (; i < n;) { start = i; c = str[i++]; if (c == '(' && str[i] == ' ') { colstate |= IN_FF_COMMENT; } if (colstate & IN_FF_COMMENT) { if (c == ')') colstate &= ~IN_FF_COMMENT; SET_COLOR1(str, start, FF_STYLE_COMMENT); continue; } if (qe_isblank(c)) continue; if (c == '\\' && str[i] == ' ') { comment: i = n; SET_COLOR(str, start, i, FF_STYLE_COMMENT); continue; } switch (c) { case ',': case '!': case '.': if (str[i] == '\"') { i++; goto string; } break; case '\"': string: /* parse string const */ for (; i < n; i++) { if (str[i] == '\\' && i + 1 < n) { i++; } else if (str[i] == '\"') { i++; break; } } has_string: SET_COLOR(str, start, i, FF_STYLE_STRING); continue; default: break; } /* scan for space and determine word type */ len = 0; word[len++] = c; for (; i < n && !qe_isblank(str[i]); i++) { if (len < countof(word) - 1) word[len++] = str[i]; } word[len] = '\0'; if (!strcmp("EOF", word) || !strcmp("EOF`", word)) { SET_COLOR(str, start, i, FF_STYLE_KEYWORD); colstate |= IN_FF_TRAIL; start = i; goto comment; } if (word[len - 1] == '\"') goto has_string; if (!strcmp("|`", word) || strfind(syn->keywords, word)) { SET_COLOR(str, start, i, FF_STYLE_KEYWORD); continue; } if (len < countof(word) - 1 && word[len - 1] != '`') { word[len] = '`'; word[len + 1] = '\0'; if (!strcmp("|`", word) || strfind(syn->keywords, word)) { SET_COLOR(str, start, i, FF_STYLE_KEYWORD); continue; } } numlen = len; if (numlen > 1 && qe_findchar("|&^+-*/%~,", word[numlen - 1])) word[--numlen] = '\0'; if (ff_match_number(word, &num) == numlen) { SET_COLOR(str, start, start + numlen, FF_STYLE_NUMBER); if (numlen < len) SET_COLOR1(str, start + numlen, FF_STYLE_KEYWORD); continue; } } cp->colorize_state = colstate; } static int ff_probe(ModeDef *mode, ModeProbeData *pd) { const char *p = (const char *)pd->buf; const char *p1 = (const char *)pd->buf + pd->line_len; if (match_extension(pd->filename, mode->extensions) || match_shell_handler(cs8(pd->buf), mode->shell_handlers)) { return 80; } if ((p[0] == ':' || p[0] == '\\') && p[1] == ' ') return 60; if ((p1[0] == ':' || p1[0] == '\\') && p[1] == ' ') return 50; return 1; } static ModeDef ff_mode = { .name = "Forth", .extensions = "ff|fth|fs|fr|4th", .shell_handlers = "forth|fth", .mode_probe = ff_probe, .keywords = ff_keywords, .colorize_func = ff_colorize_line, }; static int ff_init(void) { qe_register_mode(&ff_mode, MODEF_SYNTAX); return 0; } qe_module_init(ff_init);