(*
Copyright 2021 Anton Krotov
This file is part of CEdit.
CEdit is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
CEdit 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 General Public License for more details.
You should have received a copy of the GNU General Public License
along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Languages;
IMPORT Lines, Utils;
CONST
langText* = 0; langC* = 1; langOberon* = 2; langPascal* = 3;
langFasm* = 4; langLua* = 5; langIni* = 6; langJSON* = 7;
csLang = {langC, langOberon, langLua, langIni, langJSON};
TYPE
tLine = Lines.tLine;
tKeyWords = RECORD
words: ARRAY 200, 32 OF WCHAR; cnt: INTEGER
END;
tDelimiters = ARRAY 256 OF BOOLEAN;
procGetStr = PROCEDURE (secName, keyName: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
VAR
KW: ARRAY 8 OF ARRAY 3 OF tKeyWords;
Delim: ARRAY 8 OF tDelimiters;
currentLang: INTEGER;
fileExt: ARRAY 11 OF RECORD ext: ARRAY 8 OF CHAR; lang: INTEGER END;
PROCEDURE isCS* (lang: INTEGER): BOOLEAN;
RETURN lang IN csLang
END isCS;
PROCEDURE checkKW (s: ARRAY OF WCHAR; KW: tKeyWords): BOOLEAN;
VAR
i: INTEGER;
BEGIN
i := KW.cnt - 1;
WHILE (i >= 0) & (s # KW.words[i]) DO
DEC(i)
END
RETURN i >= 0
END checkKW;
PROCEDURE isKey* (s: ARRAY OF WCHAR; lang, kwSet: INTEGER): BOOLEAN;
RETURN checkKW(s, KW[lang][kwSet - 1])
END isKey;
PROCEDURE isDelim* (c: WCHAR): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF c <= 0FFX THEN
res := Delim[currentLang][ORD(c)]
ELSE
res := FALSE
END
RETURN res
END isDelim;
PROCEDURE SkipString* (line: tLine; VAR pos: INTEGER; n: INTEGER);
VAR
quot: WCHAR;
BEGIN
quot := Lines.getChar(line, pos);
REPEAT
INC(pos)
UNTIL (pos > n) OR (Lines.getChar(line, pos) = quot)
END SkipString;
PROCEDURE C (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
BEGIN
c := Lines.getChar(line, pos);
IF depth = 0 THEN
IF c = "/" THEN
IF cond = 0 THEN
cond := 1
ELSE
cond := 0;
pos := n
END
ELSIF (c = "*") & (cond = 1) THEN
depth := 1;
cond := 0
ELSIF (c = "'") OR (c = '"') THEN
SkipString(line, pos, n);
cond := 0
ELSE
cond := 0
END
ELSIF depth = 1 THEN
IF c = "*" THEN
cond := 1
ELSIF (c = "/") & (cond = 1) THEN
cond := 0;
depth := 0
ELSE
cond := 0
END
END
END C;
PROCEDURE getChar (line: tLine; i: INTEGER): WCHAR;
VAR
res: WCHAR;
BEGIN
IF i >= line.length THEN
res := 0X
ELSE
res := Lines.getChar(line, i)
END
RETURN res
END getChar;
PROCEDURE LuaLong* (line: tLine; pos: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
res := -1;
IF getChar(line, pos) = "[" THEN
INC(pos);
WHILE getChar(line, pos) = "=" DO
INC(res);
INC(pos)
END;
IF getChar(line, pos) = "[" THEN
INC(res)
ELSE
res := -1
END
END
RETURN res
END LuaLong;
PROCEDURE Lua (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
k: INTEGER;
BEGIN
c := Lines.getChar(line, pos);
IF depth = 0 THEN
IF c = "-" THEN
IF cond = 0 THEN
cond := 1
ELSE
cond := 0;
k := LuaLong(line, pos + 1);
IF k >= 0 THEN
depth := k*2 + 1
ELSE
pos := n
END
END
ELSIF c = "[" THEN
cond := 0;
k := LuaLong(line, pos);
IF k >= 0 THEN
depth := (k + 1)*2
END
ELSIF (c = "'") OR (c = '"') THEN
SkipString(line, pos, n);
cond := 0
ELSE
cond := 0
END
ELSIF depth > 0 THEN
IF (cond = 0) & (c = "]") THEN
cond := 1
ELSIF (cond >= 1) & (c = "=") THEN
INC(cond)
ELSIF (cond >= 1) & (c = "]") & (cond*2 - depth MOD 2 = depth) THEN
depth := 0;
cond := 0
ELSE
cond := 0
END
END
END Lua;
PROCEDURE Pascal (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
BEGIN
c := Lines.getChar(line, pos);
IF depth = 0 THEN
IF c = "(" THEN
cond := 1
ELSIF c = "/" THEN
IF cond = 2 THEN
cond := 0;
pos := n
ELSE
cond := 2
END
ELSIF (c = "*") & (cond = 1) THEN
depth := 2;
cond := 0
ELSIF c = "'" THEN
SkipString(line, pos, n);
cond := 0
ELSIF c = "{" THEN
IF Lines.getChar(line, pos + 1) = "$" THEN
depth := 3
ELSE
depth := 1
END;
cond := 0
ELSE
cond := 0
END
ELSIF depth IN {1, 3} THEN
IF c = "}" THEN
depth := 0
END
ELSIF depth = 2 THEN
IF c = "*" THEN
cond := 1
ELSIF (c = ")") & (cond = 1) THEN
depth := 0;
cond := 0
ELSE
cond := 0
END
END
END Pascal;
PROCEDURE Oberon (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
BEGIN
c := Lines.getChar(line, pos);
IF (depth = 0) & (c = "/") THEN
IF cond = 3 THEN
cond := 0;
pos := n
ELSE
cond := 3
END
ELSIF (depth = 0) & ((c = "'") OR (c = '"')) THEN
SkipString(line, pos, n);
cond := 0
ELSIF c = "(" THEN
cond := 1
ELSIF c = "*" THEN
IF cond = 1 THEN
INC(depth);
cond := 0
ELSE
cond := 2
END
ELSIF c = ")" THEN
IF cond = 2 THEN
IF depth > 0 THEN
DEC(depth)
END
END;
cond := 0
ELSE
cond := 0
END;
END Oberon;
PROCEDURE Ini (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
c: WCHAR;
BEGIN
cond := 0;
c := Lines.getChar(line, pos);
IF depth = 0 THEN
IF c = ";" THEN
pos := n
ELSIF c = '"' THEN
SkipString(line, pos, n)
ELSIF c = "[" THEN
depth := 1
END
ELSIF depth = 1 THEN
IF c = "]" THEN
depth := 0
END
END
END Ini;
PROCEDURE comments* (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER; lang: INTEGER);
BEGIN
CASE lang OF
|langText:
|langFasm:
|langC,
langJSON: C(line, depth, cond, pos, n)
|langOberon: Oberon(line, depth, cond, pos, n)
|langPascal: Pascal(line, depth, cond, pos, n)
|langLua: Lua(line, depth, cond, pos, n)
|langIni: Ini(line, depth, cond, pos, n)
END
END comments;
PROCEDURE EnterKW (s: ARRAY OF CHAR; VAR KW: tKeyWords; CPrep: BOOLEAN);
CONST
SPACE = 20X; CR = 0DX; LF = 0AX; TAB = 9X; COMMA = ",";
VAR
i, j, k: INTEGER;
PROCEDURE delim (c: CHAR): BOOLEAN;
RETURN (c = COMMA) OR (c = SPACE) OR (c = CR) OR (c = LF) OR (c = TAB)
END delim;
BEGIN
k := KW.cnt;
i := 0;
REPEAT
KW.words[k, 0] := "#";
j := ORD(CPrep);
WHILE (s[i] # 0X) & ~delim(s[i]) DO
KW.words[k, j] := WCHR(ORD(s[i]));
INC(i);
INC(j)
END;
KW.words[k, j] := 0X;
INC(k);
WHILE delim(s[i]) DO
INC(i)
END
UNTIL s[i] = 0X;
KW.cnt := k
END EnterKW;
PROCEDURE loadKW (VAR KW: ARRAY OF tKeyWords; VAR delim: tDelimiters; getStr: procGetStr; lang: ARRAY OF CHAR);
VAR
s: ARRAY 16*1024 OF CHAR;
key: ARRAY 4 OF CHAR;
i: INTEGER;
BEGIN
FOR i := 0 TO LEN(delim) - 1 DO
delim[i] := FALSE
END;
getStr(lang, "delim", s);
i := 0;
WHILE s[i] # 0X DO
delim[ORD(s[i])] := TRUE;
INC(i)
END;
key := "KW1";
FOR i := 0 TO 2 DO
KW[i].cnt := 0;
key[2] := CHR(ORD("1") + i);
getStr(lang, key, s);
EnterKW(s, KW[i], (lang = "lang_C") & (i = 1))
END
END loadKW;
PROCEDURE setCurLang* (lang: INTEGER);
BEGIN
currentLang := lang
END setCurLang;
PROCEDURE getLang* (ext: ARRAY OF CHAR): INTEGER;
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (i < LEN(fileExt)) & (fileExt[i].ext # ext) DO
INC(i)
END;
IF i < LEN(fileExt) THEN
i := fileExt[i].lang
ELSE
i := langText
END
RETURN i
END getLang;
PROCEDURE getExt* (lang: INTEGER; VAR ext: ARRAY OF CHAR);
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE fileExt[i].lang # lang DO
INC(i)
END;
COPY(fileExt[i].ext, ext);
Utils.lowcase(ext)
END getExt;
PROCEDURE init* (getStr: procGetStr);
BEGIN
currentLang := langText;
loadKW(KW[langText], Delim[langText], getStr, "lang_Text");
loadKW(KW[langOberon], Delim[langOberon], getStr, "lang_Oberon");
loadKW(KW[langC], Delim[langC], getStr, "lang_C");
loadKW(KW[langPascal], Delim[langPascal], getStr, "lang_Pascal");
loadKW(KW[langLua], Delim[langLua], getStr, "lang_Lua");
loadKW(KW[langIni], Delim[langIni], getStr, "lang_Ini");
loadKW(KW[langFasm], Delim[langFasm], getStr, "lang_Fasm");
loadKW(KW[langJSON], Delim[langJSON], getStr, "lang_JSON");
fileExt[ 0].ext := "OB07"; fileExt[ 0].lang := langOberon;
fileExt[ 1].ext := "C"; fileExt[ 1].lang := langC;
fileExt[ 2].ext := "H"; fileExt[ 2].lang := langC;
fileExt[ 3].ext := "CPP"; fileExt[ 3].lang := langC;
fileExt[ 4].ext := "PAS"; fileExt[ 4].lang := langPascal;
fileExt[ 5].ext := "PP"; fileExt[ 5].lang := langPascal;
fileExt[ 6].ext := "ASM"; fileExt[ 6].lang := langFasm;
fileExt[ 7].ext := "LUA"; fileExt[ 7].lang := langLua;
fileExt[ 8].ext := "INI"; fileExt[ 8].lang := langIni;
fileExt[ 9].ext := "JSON"; fileExt[ 9].lang := langJSON;
fileExt[10].ext := "TXT"; fileExt[10].lang := langText;
END init;
END Languages.