markmental/evil-qemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
evil-qemacs/lang/forth.c
Charlie Gordon 7e70e611b6 Use char32_t for all code point variables and arrays 
- char32_t is defined in cutils.h but may conflict with <uchar.h>
- all qe_isxxx functions take a char32_t
- add etf8x encoding for full range of char32_t type
- add utf8_decode_strict()
- add ustr_match_keyword()
- utf8_encode() / utf8_decode() handle up to 32 bits
- improve detect_charset():
  - detect utf8 and utf8x
  - avoid failure on partial utf8 sequence at end of buffer
  - detect overlong utf8 sequences
- fix display bugs for code points beyond MAX_UNICODE_DISPLAY
- simplify do_compare_windows(), avoid magic char values.
- rename functions:
    eb_encode_uchar -> eb_encode_char32
    eb_insert_uchar -> eb_insert_char32
    eb_insert_uchars -> eb_insert_char32_n
    eb_match_uchar -> eb_match_char32
    eb_delete_uchar -> eb_delete_char32
    eb_replace_uchar -> eb_replace_char32
    utf8_to_unicode -> utf8_to_char32
- use char32_t for all variables and arrays holding code-points
- fix some language syntax parsers.
- fix detect_eol_type_32bit(), used uint16_t instead of uint32_t
- bump VERSION to 5.4.0
2022-10-29 19:43:38 +02:00

334 lines
11 KiB
C
Raw Blame History

/*
* Miscellaneous QEmacs modes for Forth variants
*
* Copyright (c) 2014-2022 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 ----------------*/
static 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`|0>=if`|=if`|<>if`|<if`"
"|<=if`|u<if`|u<=if`|then`|;then`|else`|again`|while`|repeat`|for`"
"|next`|[THEN]`|[ELSE]`|[IF]`|[0]`|[1]`|[~]`|[os]`|syscall|stdin|stdout"
"|open'|openr|openw|openw0|close|read|write|lseek|ioctl|select"
"|malloc|free|type|accept|emit|space|cr|key|.|.\\|.digit|base"
"|.l|.w|.b|.#s|.dec|.dec\\|dump|2dump|;dump`|stopdump?|ui|prompt"
"|.s`|.h`|words`|hid'm`|mark`|marker|loc:`|needs`|needed|eval|bye`"
"|exit|#lib|#fun|#call|lib:`|fun:`|libc.`|libc|man`|k32.`|k32"
"|win32.hlp`|ior|?ior|zt|cd`|shell|!!`|cls`|home|atxy|normal"
"|background|foreground|.d|.wd|.dt|.t|.now`|now|ms|ms@|}}}`|{{{`"
"|fcell|fsw@|fcw@|fcw!|floor|f>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, digit;
char32_t c;
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,
char32_t *str, int n, ModeDef *syn)
{
char word[64];
int i = 0, start = 0, num = 0, len, numlen, colstate = cp->colorize_state;
char32_t c;
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 (strequal("EOF", word) || strequal("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 (strequal("|`", 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 (strequal("|`", 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);
Reference in a new issue View git blame Copy permalink