534 lines
17 KiB
C
534 lines
17 KiB
C
/*
|
|
* Lisp Source mode for QEmacs.
|
|
*
|
|
* Copyright (c) 2000-2017 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"
|
|
|
|
/* TODO: lisp-indent = 2 */
|
|
|
|
#define LISP_LANG_LISP 1
|
|
#define LISP_LANG_ELISP 2
|
|
#define LISP_LANG_SCHEME 4
|
|
#define LISP_LANG_RACKET 8
|
|
#define LISP_LANG_CLOJURE 16
|
|
#define LISP_LANG_SANDBOX 32
|
|
#define LISP_LANG_XAOS 64
|
|
|
|
/*---------------- Lisp colors ----------------*/
|
|
|
|
static const char lisp_keywords[] = {
|
|
"defun|let|let*|set|setq|prog1|progn|cond|if|unless|when|while|"
|
|
"defsubst|remove|otherwise|dolist|incf|decf|boundp|"
|
|
"and|or|not|case|eq|"
|
|
"cons|list|concat|car|cdr|setcar|setcdr|nth|nthcdr|length|"
|
|
"reverse|sort|"
|
|
"caar|cadr|cdar|cddr|caddr|cadddr|"
|
|
"lambda|"
|
|
"\xCE\xBB|" /* greek character lambda in utf-8 */
|
|
"mod|abs|max|min|log|logand|logior|logxor|ash|"
|
|
"1+|1-|<|>|<=|>=|-|+|*|/|=|<>|/=|"
|
|
};
|
|
|
|
static const char elisp_keywords[] = {
|
|
/* elisp primitives */
|
|
"eval|load|read|null|get|put|catch|throw|unwind-protect|atom|delete|"
|
|
"dotimes|aset|aref|setplist|equal|fset|setq-default|pcase-let|"
|
|
"consp|vectorp|listp|symbolp|stringp|numberp|zerop|functionp|integerp|"
|
|
"assq|apply|funcall|mapatoms|mapc|mapcar|mapconcat|plist-get|plist-put|"
|
|
"function|intern|intern-soft|copy-sequence|delete-dups|fboundp|"
|
|
"push|pop|append|nconc|nreverse|memq|delq|remq|pcase|assoc|member|"
|
|
"defalias|defgroup|defmacro|type-of|condition-case|declare-function|"
|
|
"make-obsolete-variable|define-obsolete-variable-alias|set-default|"
|
|
"default-boundp|default-value|car-safe|cdr-safe|"
|
|
"make-variable-buffer-local|make-local-variable|local-variable-p|"
|
|
"symbol-value|symbol-name|symbol-function|symbol-plist|"
|
|
"string-match|downcase|upcase|string<|string=|format|substring|"
|
|
"string-lessp|string-as-unibyte|"
|
|
"format-time-string|current-time-string|"
|
|
"string-to-number|number-to-string|read-from-string|char-to-string|"
|
|
"make-string|string-to-char|string-equal|split-string|"
|
|
"regexp-quote|"
|
|
"make-vector|vector|vconcat|add-to-list|"
|
|
/* emacs specific stuff */
|
|
"eval-when-compile|assert|cl-assert|cl-pushnew|require|provide|"
|
|
"interactive|save-excursion|save-restriction|error|message|sit-for|"
|
|
"save-match-data|narrow-to-region|widen|"
|
|
"call-interactively|run-hooks|add-hook|remove-hook|run-hook-with-args|"
|
|
"defcustom|defvar|defconst|featurep|defvar-local|commandp|macrop|"
|
|
"define-minor-mode|define-derived-mode|define-major-mode|"
|
|
"define-key|make-keymap|make-sparse-keymap|key-binding|keymapp|lookup-key|"
|
|
/* editing primitives */
|
|
"marker-position|move-marker|copy-marker|set-marker|markerp|point-marker|"
|
|
"mark|point|goto-char|char-after|preceding-char|following-char|"
|
|
"current-column|"
|
|
"move-beginning-of-line|move-end-of-line|beginning-of-line|end-of-line|"
|
|
"count-lines|line-move|open-line|newline|"
|
|
"region-beginning|region-end|line-beginning-position|line-end-position|"
|
|
"line-beginning|line-end|bobp|eobp|bolp|eolp|"
|
|
"forward-word|backward-word|forward-line|backward-line|"
|
|
"forward-char|backward-char|skip-chars-forward|"
|
|
"push-mark|point-min|point-max|exchange-point-and-mark|"
|
|
"match-beginning|match-end|match-data|set-match-data|replace-match|"
|
|
"search-forward|search-backward|re-search-forward|re-search-backward|"
|
|
"looking-at|looking-back|"
|
|
"display-buffer|erase-buffer|current-buffer|"
|
|
"buffer-modified-p|set-buffer-modified-p|"
|
|
"save-current-buffer|buffer-file-name|buffer-name|buffer-list|buffer-size|"
|
|
"set-buffer|"
|
|
"switch-to-buffer|get-buffer-create|kill-buffer|"
|
|
"buffer-substring|buffer-substring-no-properties|"
|
|
"set-text-properties|remove-text-properties|"
|
|
"get-char-property|get-text-property|put-text-property|"
|
|
"read-char|read-string|read-file-name|y-or-n-p|yes-or-no-p|"
|
|
"completing-read|"
|
|
"expand-file-name|file-name-directory|"
|
|
"with-current-buffer|with-temp-buffer|"
|
|
"with-syntax-table|syntax-table|standard-syntax-table|"
|
|
"skip-syntax-forward|skip-syntax-backward|skip-chars-backward|"
|
|
"insert|delete-char|delete-region|prin1|princ|terpri|indent-to|"
|
|
"insert-file-contents|"
|
|
"downcase-region|upcase-region|upcase-initials-region|"
|
|
"delete-horizontal-space|kill-line|kill-region|yank|yank-pop|"
|
|
"move-to-column|align|align-column|align-region|indent-region|"
|
|
"write-region|undo-boundary|undo-in-progress|window-minibuffer-p|"
|
|
"make-overlay|delete-overlay|remove-overlays|move-overlay|"
|
|
"overlay-start|overlay-end|overlays-at|overlay-get|overlay-put|"
|
|
"overlay-buffer|overlay-properties|"
|
|
"define-abbrev|abbrev-get|abbrev-put|"
|
|
"defface|make-face|set-face-property|facep|"
|
|
};
|
|
|
|
static const char scheme_keywords[] = {
|
|
""
|
|
};
|
|
|
|
static const char racket_keywords[] = {
|
|
""
|
|
};
|
|
|
|
static const char clojure_keywords[] = {
|
|
""
|
|
};
|
|
|
|
static const char sandbox_keywords[] = {
|
|
""
|
|
};
|
|
|
|
static const char lisp_types[] = {
|
|
"nil|t|"
|
|
};
|
|
|
|
static const char elisp_types[] = {
|
|
"nil|t|&optional|"
|
|
};
|
|
|
|
enum {
|
|
IN_LISP_LEVEL = 0x1F, /* for IN_LISP_SCOMMENT */
|
|
IN_LISP_COMMENT = 0x20,
|
|
IN_LISP_STRING = 0x40,
|
|
IN_LISP_SCOMMENT = 0x80,
|
|
};
|
|
|
|
enum {
|
|
LISP_STYLE_TEXT = QE_STYLE_DEFAULT,
|
|
LISP_STYLE_COMMENT = QE_STYLE_COMMENT,
|
|
LISP_STYLE_SCOMMENT = QE_STYLE_COMMENT,
|
|
LISP_STYLE_NUMBER = QE_STYLE_NUMBER,
|
|
LISP_STYLE_STRING = QE_STYLE_STRING,
|
|
LISP_STYLE_CHARCONST = QE_STYLE_STRING_Q,
|
|
LISP_STYLE_KEYWORD = QE_STYLE_KEYWORD,
|
|
LISP_STYLE_TYPE = QE_STYLE_TYPE,
|
|
LISP_STYLE_QSYMBOL = QE_STYLE_PREPROCESS,
|
|
LISP_STYLE_MACRO = QE_STYLE_TAG,
|
|
LISP_STYLE_PREPROCESS = QE_STYLE_PREPROCESS,
|
|
};
|
|
|
|
static int lisp_get_symbol(char *buf, int buf_size, unsigned int *p)
|
|
{
|
|
buf_t outbuf, *out;
|
|
unsigned int c;
|
|
int i;
|
|
|
|
out = buf_init(&outbuf, buf, buf_size);
|
|
|
|
for (i = 0; (c = p[i]) != '\0'; i++) {
|
|
if (qe_isblank(c) || qe_findchar(";(){}[]#'`,\"", c))
|
|
break;
|
|
buf_putc_utf8(out, c);
|
|
}
|
|
return i;
|
|
}
|
|
|
|
static int lisp_is_number(const char *str)
|
|
{
|
|
int i;
|
|
|
|
if (*str == 'b' && str[1]) {
|
|
for (str++; qe_isbindigit(*str); str++)
|
|
continue;
|
|
} else
|
|
if (*str == 'o' && str[1]) {
|
|
for (str++; qe_isoctdigit(*str); str++)
|
|
continue;
|
|
} else
|
|
if (*str == 'x' && str[1]) {
|
|
for (str++; qe_isxdigit(*str); str++)
|
|
continue;
|
|
} else {
|
|
if ((*str == '-' || *str == 'd') && str[1])
|
|
str++;
|
|
if (qe_isdigit(*str)) {
|
|
for (; qe_isdigit(*str); str++)
|
|
continue;
|
|
if (*str == '.') {
|
|
for (str++; qe_isdigit(*str); str++)
|
|
continue;
|
|
}
|
|
if (qe_tolower(*str) == 'e') {
|
|
i = 1;
|
|
if (str[i] == '+' || str[i] == '-')
|
|
i++;
|
|
if (qe_isdigit(str[i])) {
|
|
for (str += i + 1; qe_isdigit(*str); str++)
|
|
continue;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return (*str) ? 0 : 1;
|
|
}
|
|
|
|
static void lisp_colorize_line(QEColorizeContext *cp,
|
|
unsigned int *str, int n, ModeDef *syn)
|
|
{
|
|
int colstate = cp->colorize_state;
|
|
int i = 0, start = i, len, level, style, style1, has_expr;
|
|
int mode_flags = syn->colorize_flags;
|
|
char kbuf[64];
|
|
|
|
level = colstate & IN_LISP_LEVEL;
|
|
style1 = style = 0;
|
|
has_expr = 0;
|
|
|
|
if (colstate & IN_LISP_SCOMMENT)
|
|
style1 = LISP_STYLE_SCOMMENT;
|
|
if (colstate & IN_LISP_STRING)
|
|
goto parse_string;
|
|
if (colstate & IN_LISP_COMMENT)
|
|
goto parse_comment;
|
|
|
|
while (i < n) {
|
|
has_expr = 0;
|
|
start = i;
|
|
switch (str[i++]) {
|
|
case ',':
|
|
if (str[i] == '@')
|
|
i++;
|
|
/* FALL THRU */
|
|
case '`':
|
|
style = LISP_STYLE_MACRO;
|
|
break;
|
|
case ';':
|
|
i = n;
|
|
style = LISP_STYLE_COMMENT;
|
|
break;
|
|
case '(':
|
|
if (colstate & IN_LISP_SCOMMENT)
|
|
level++;
|
|
break;
|
|
case ')':
|
|
if (colstate & IN_LISP_SCOMMENT) {
|
|
if (level-- <= 1) {
|
|
SET_COLOR(str, start, i - (level < 0), style1);
|
|
colstate &= ~IN_LISP_SCOMMENT;
|
|
level = 0;
|
|
style1 = 0;
|
|
continue;
|
|
}
|
|
}
|
|
break;
|
|
case '#':
|
|
if (str[i] == '|') {
|
|
/* #| ... |# -> block comment */
|
|
colstate |= IN_LISP_COMMENT;
|
|
i++;
|
|
parse_comment:
|
|
for (; i < n; i++) {
|
|
if (str[i] == '|' && str[i + 1] == '#') {
|
|
i += 2;
|
|
colstate &= ~IN_LISP_COMMENT;
|
|
break;
|
|
}
|
|
}
|
|
style = LISP_STYLE_COMMENT;
|
|
break;
|
|
}
|
|
if (str[i] == ';') {
|
|
/* #; sexpr -> comment out sexpr */
|
|
i++;
|
|
colstate |= IN_LISP_SCOMMENT;
|
|
style1 = LISP_STYLE_SCOMMENT;
|
|
break;
|
|
}
|
|
if (str[i] == '"') {
|
|
i++;
|
|
colstate |= IN_LISP_STRING;
|
|
goto parse_string;
|
|
}
|
|
if (str[i] == ':'
|
|
&& (str[i + 1] == '-' || qe_isalnum_(str[i + 1]))) {
|
|
len = lisp_get_symbol(kbuf, sizeof(kbuf), str + i + 1);
|
|
i += 1 + len;
|
|
goto has_symbol;
|
|
}
|
|
if (qe_isalpha_(str[i])) {
|
|
len = lisp_get_symbol(kbuf, sizeof(kbuf), str + i);
|
|
i += len;
|
|
if (!strcmp(kbuf, "t") || !strcmp(kbuf, "f")) {
|
|
/* #f -> false, #t -> true */
|
|
goto has_qsymbol;
|
|
}
|
|
if (mode_flags & LISP_LANG_RACKET) {
|
|
if (start == 0 && !strcmp(kbuf, "lang")) {
|
|
i = n;
|
|
style = LISP_STYLE_PREPROCESS;
|
|
break;
|
|
}
|
|
if (!strcmp(kbuf, "rx") || !strcmp(kbuf, "px")) {
|
|
if (str[i] == '"') {
|
|
/* #rx"regex" */
|
|
i += 1;
|
|
colstate |= IN_LISP_STRING;
|
|
goto parse_string;
|
|
}
|
|
if (str[i] == '#' && str[i + 1] == '"') {
|
|
/* #rx#"regex" */
|
|
i += 2;
|
|
colstate |= IN_LISP_STRING;
|
|
goto parse_string;
|
|
}
|
|
}
|
|
}
|
|
/* #b[01]+ -> binary constant */
|
|
/* #o[0-7]+ -> octal constant */
|
|
/* #d[0-9]+ -> decimal constant */
|
|
/* #x[0-9a-fA-F]+ -> hex constant */
|
|
goto has_symbol;
|
|
}
|
|
if (str[i] == '\\') {
|
|
if (qe_isalnum_(str[i + 1])) {
|
|
/* #\x[0-9a-fA-F]+ -> hex char constant */
|
|
/* #\[a-zA-Z0-9]+ -> named char constant */
|
|
len = lisp_get_symbol(kbuf, sizeof(kbuf), str + i + 1);
|
|
i += 1 + len;
|
|
goto has_char_const;
|
|
}
|
|
if (i + 1 < n) {
|
|
i += 2;
|
|
goto has_char_const;
|
|
}
|
|
}
|
|
{
|
|
/* #( ... ) -> vector object */
|
|
/* #! ... \n -> line comment */
|
|
/* # SPC -> NIL ? */
|
|
}
|
|
break;
|
|
case '"':
|
|
/* parse string const */
|
|
colstate |= IN_LISP_STRING;
|
|
parse_string:
|
|
while (i < n) {
|
|
if (str[i] == '\\' && ++i < n) {
|
|
i++;
|
|
} else
|
|
if (str[i++] == '"') {
|
|
colstate &= ~IN_LISP_STRING;
|
|
has_expr = 1;
|
|
break;
|
|
}
|
|
}
|
|
style = LISP_STYLE_STRING;
|
|
break;
|
|
case '?':
|
|
/* parse char const */
|
|
/* XXX: Should parse keys syntax */
|
|
if (str[i] == '\\' && i + 1 < n) {
|
|
i += 2;
|
|
} else
|
|
if (i < n) {
|
|
i += 1;
|
|
}
|
|
has_char_const:
|
|
has_expr = 1;
|
|
style = LISP_STYLE_CHARCONST;
|
|
break;
|
|
case '\'':
|
|
len = lisp_get_symbol(kbuf, sizeof(kbuf), str + i);
|
|
if (len > 0) {
|
|
i += len;
|
|
has_qsymbol:
|
|
has_expr = 1;
|
|
style = LISP_STYLE_QSYMBOL;
|
|
break;
|
|
}
|
|
break;
|
|
default:
|
|
len = lisp_get_symbol(kbuf, sizeof(kbuf), str + i - 1);
|
|
if (len > 0) {
|
|
i += len - 1;
|
|
has_symbol:
|
|
has_expr = 1;
|
|
if (lisp_is_number(kbuf)) {
|
|
style = LISP_STYLE_NUMBER;
|
|
break;
|
|
}
|
|
if (strfind(lisp_keywords, kbuf)
|
|
|| strfind(syn->keywords, kbuf)) {
|
|
style = LISP_STYLE_KEYWORD;
|
|
break;
|
|
}
|
|
if (strfind(syn->types, kbuf)) {
|
|
style = LISP_STYLE_TYPE;
|
|
break;
|
|
}
|
|
/* skip other symbol */
|
|
break;
|
|
}
|
|
break;
|
|
}
|
|
if (style1) {
|
|
style = style1;
|
|
if (has_expr) {
|
|
if ((colstate & IN_LISP_SCOMMENT) && level <= 0) {
|
|
colstate &= ~IN_LISP_SCOMMENT;
|
|
level = 0;
|
|
style1 = 0;
|
|
}
|
|
}
|
|
}
|
|
if (style) {
|
|
SET_COLOR(str, start, i, style);
|
|
style = 0;
|
|
}
|
|
}
|
|
colstate = (colstate & ~IN_LISP_LEVEL) | (level & IN_LISP_LEVEL);
|
|
cp->colorize_state = colstate;
|
|
}
|
|
|
|
static int elisp_mode_probe(ModeDef *mode, ModeProbeData *p)
|
|
{
|
|
/* check file name or extension */
|
|
if (match_extension(p->filename, mode->extensions)
|
|
|| match_shell_handler(cs8(p->buf), mode->shell_handlers)
|
|
|| strstart(p->filename, ".emacs", NULL))
|
|
return 80;
|
|
|
|
return 1;
|
|
}
|
|
|
|
ModeDef lisp_mode = {
|
|
.name = "Lisp",
|
|
.extensions = "ll|li|lh|lo|lm|lisp",
|
|
.keywords = NULL,
|
|
.shell_handlers = "lisp",
|
|
.types = lisp_types,
|
|
.colorize_func = lisp_colorize_line,
|
|
.colorize_flags = LISP_LANG_LISP,
|
|
};
|
|
|
|
static ModeDef elisp_mode = {
|
|
.name = "ELisp",
|
|
.extensions = "el",
|
|
.keywords = elisp_keywords,
|
|
.types = elisp_types,
|
|
.mode_probe = elisp_mode_probe,
|
|
.colorize_func = lisp_colorize_line,
|
|
.colorize_flags = LISP_LANG_ELISP,
|
|
.fallback = &lisp_mode,
|
|
};
|
|
|
|
static ModeDef scheme_mode = {
|
|
.name = "Scheme",
|
|
.extensions = "scm|sch|ss",
|
|
.keywords = scheme_keywords,
|
|
.types = lisp_types,
|
|
.colorize_func = lisp_colorize_line,
|
|
.colorize_flags = LISP_LANG_SCHEME,
|
|
.fallback = &lisp_mode,
|
|
};
|
|
|
|
static ModeDef racket_mode = {
|
|
.name = "Racket",
|
|
.extensions = "rkt|rktd",
|
|
.keywords = racket_keywords,
|
|
.types = lisp_types,
|
|
.colorize_func = lisp_colorize_line,
|
|
.colorize_flags = LISP_LANG_RACKET,
|
|
.fallback = &lisp_mode,
|
|
};
|
|
|
|
static ModeDef clojure_mode = {
|
|
.name = "Clojure",
|
|
.extensions = "clj",
|
|
.keywords = clojure_keywords,
|
|
.types = lisp_types,
|
|
.colorize_func = lisp_colorize_line,
|
|
.colorize_flags = LISP_LANG_CLOJURE,
|
|
.fallback = &lisp_mode,
|
|
};
|
|
|
|
static ModeDef sandbox_mode = {
|
|
.name = "Sandbox", /* MacOS, Tinyscheme based? */
|
|
.extensions = "sb",
|
|
.keywords = sandbox_keywords,
|
|
.types = lisp_types,
|
|
.colorize_func = lisp_colorize_line,
|
|
.colorize_flags = LISP_LANG_SANDBOX,
|
|
.fallback = &lisp_mode,
|
|
};
|
|
|
|
static const char xaos_keywords[] = {
|
|
""
|
|
};
|
|
|
|
static ModeDef xaos_mode = {
|
|
.name = "Xaos", /* Xaos fractal generator */
|
|
.extensions = "xhf|xaf|xpf",
|
|
.keywords = xaos_keywords,
|
|
.types = lisp_types,
|
|
.colorize_func = lisp_colorize_line,
|
|
.colorize_flags = LISP_LANG_XAOS,
|
|
.fallback = &lisp_mode,
|
|
};
|
|
|
|
static int lisp_init(void)
|
|
{
|
|
qe_register_mode(&lisp_mode, MODEF_SYNTAX);
|
|
qe_register_mode(&elisp_mode, MODEF_SYNTAX);
|
|
qe_register_mode(&scheme_mode, MODEF_SYNTAX);
|
|
qe_register_mode(&racket_mode, MODEF_SYNTAX);
|
|
qe_register_mode(&clojure_mode, MODEF_SYNTAX);
|
|
qe_register_mode(&sandbox_mode, MODEF_SYNTAX);
|
|
qe_register_mode(&xaos_mode, MODEF_SYNTAX);
|
|
|
|
return 0;
|
|
}
|
|
|
|
qe_module_init(lisp_init);
|