From 080e40dbb8cce482a80d68f2e288cc4e27043432 Mon Sep 17 00:00:00 2001 From: Charlie Gordon Date: Fri, 30 May 2014 17:53:18 +0000 Subject: [PATCH] add mode for Forth languages --- Makefile | 2 +- forth.c | 339 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 340 insertions(+), 1 deletion(-) create mode 100644 forth.c diff --git a/Makefile b/Makefile index 9a4a86f..1381b64 100644 --- a/Makefile +++ b/Makefile @@ -109,7 +109,7 @@ endif OBJS+= charsetjis.o charsetmore.o ifdef CONFIG_ALL_MODES - OBJS+= unihex.o bufed.o clang.o xml.o htmlsrc.o \ + OBJS+= unihex.o bufed.o clang.o xml.o htmlsrc.o forth.o \ lisp.o makemode.o markdown.o orgmode.o perl.o script.o extra-modes.o ifndef CONFIG_WIN32 OBJS+= shell.o dired.o latex-mode.o archive.o diff --git a/forth.c b/forth.c new file mode 100644 index 0000000..db844cf --- /dev/null +++ b/forth.c @@ -0,0 +1,339 @@ +/* + * 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_isspace(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_isspace(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 (syn && syn->keywords) { + 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 *syn, ModeProbeData *pd) +{ + const char *p = (const char *)pd->buf; + const char *p1 = (const char *)pd->buf + pd->line_len; + + if (match_extension(pd->filename, syn->extensions)) + return 80; + + if (p[0] == '#' && p[1] == '!') { + if (memstr(p, pd->line_len, "forth") + || memstr(p, pd->line_len, "fth") + || memstr(p, pd->line_len, "needs")) { + 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", + .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);