This repository has been archived on 2023-07-11. You can view files and clone it, but cannot push or open issues or pull requests.
fte/h_perl.cpp

599 lines
23 KiB
C++
Raw Permalink Normal View History

/* h_perl.cpp
*
* Copyright (c) 1994-1996, Marko Macek
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* Perl Mode
*
* TODO:
* here documents, formats
* OS/2 EXTPROC...,
* UNIX #! starts hilit ?
* POD highlighting (need two keyword sets).
* some tab handling (in & foo, etc -- if allowed)/
*/
#include "fte.h"
#ifdef CONFIG_HILIT_PERL
#define X_BIT 0x80 /* set if last was number, var, */
#define X_MASK 0x7F
#define X_NOT(state) (!((state) & X_BIT))
#define kwd(x) (isalnum(x) || (x) == '_')
#define IS_OBRACE(x) \
((x) == '(' || (x) == '{' || (x) == '<' || (x) == '[')
#define NUM_BRACE(x) \
( \
(x) == '(' ? 0U : \
(x) == '{' ? 1U : \
(x) == '<' ? 2U : \
(x) == '[' ? 3U : 0U \
)
#define GET_BRACE(x) \
( \
(x) == 0 ? '(' : \
(x) == 1 ? '{' : \
(x) == 2 ? '<' : \
(x) == 3 ? '[' : 0 \
)
#define IS_MBRACE(y,x) \
( \
((y) == '(' && (x) == ')') || \
((y) == '{' && (x) == '}') ||\
((y) == '<' && (x) == '>') ||\
((y) == '[' && (x) == ']') \
)
#define QCHAR(state) ((char)(((state) >> 8) & 0xFF))
#define QSET(state, ch) ((unsigned short)((unsigned short)(state) | (((unsigned short)(ch)) << 8)))
#define hsPerl_Punct 0
#define hsPerl_Comment 1
#define hsPerl_Normal 30
#define hsPerl_Keyword 4
#define hsPerl_String1 10
#define hsPerl_String2 11
#define hsPerl_StringBk 22
#define hsPerl_Variable 23
#define hsPerl_Number 24
#define hsPerl_Function 25
#define hsPerl_RegexpM 26
#define hsPerl_RegexpS1 28
#define hsPerl_RegexpS2 29
#define hsPerl_Docs 31
#define hsPerl_Data 32
#define hsPerl_RegexpS3 33
#define hsPerl_Quote1Op 35
#define hsPerl_Quote1 36
#define hsPerl_Quote1M 37
#define hsPerl_Regexp1Op 38
#define hsPerl_Regexp1 39
#define hsPerl_Regexp1M 40
#define hsPerl_Regexp2Op 41
#define hsPerl_Regexp2 42
#define hsPerl_Regexp2M 43
#define hsPerl_HereDoc 44 // hack (eod not detected properly)
#define opQ 1
#define opQQ 2
#define opQW 3
#define opQX 4
#define opM 5
#define opS 6
#define opTR 7
int Hilit_PERL(EBuffer *BF, int /*LN*/, PCell B, int Pos, int Width, ELine *Line, hlState &State, hsState *StateMap, int *ECol) {
ChColor *Colors = BF->Mode->fColorize->Colors;
int j;
HILIT_VARS(Colors[CLR_Normal], Line);
int firstnw = 0;
int op;
int setHereDoc = 0;
#define MAXSEOF 100
static char hereDocKey[MAXSEOF];
C = 0;
NC = 0;
int isEOHereDoc = 0;
for(i = 0; i < Line->Count;) {
if (*p != ' ' && *p != 9) firstnw++;
if ((State & X_MASK) == hsPerl_HereDoc && 0 == i)
{
isEOHereDoc = strlen(hereDocKey) == (size_t)len &&
strncmp(hereDocKey, Line->Chars, len) == 0;
}
IF_TAB() else {
// printf("State = %d pos = %d", State, i); fflush(stdout);
switch (State & X_MASK) {
default:
case hsPerl_Normal:
if (i == 0 && X_NOT(State) && len == 7 &&
p[0] == '_' &&
p[1] == '_' &&
p[2] == 'E' &&
p[3] == 'N' &&
p[4] == 'D' &&
p[5] == '_' &&
p[6] == '_')
{
State = hsPerl_Data;
Color = Colors[CLR_Comment];
hilit5:
ColorNext();
//hilit4:
ColorNext();
//hilit3:
ColorNext();
hilit2:
ColorNext();
hilit:
ColorNext();
continue;
} else if (i == 0 && X_NOT(State) && (*p == '=') && len > 4 &&
p[1] == 'h' && p[2] == 'e' && p[3] == 'a' && p[4] == 'd')
{
State = hsPerl_Docs;
Color = Colors[CLR_Comment];
goto hilit5;
} else if (isalpha(*p) || *p == '_') {
op = -1;
j = 0;
while (((i + j) < Line->Count) &&
(isalnum(Line->Chars[i+j]) ||
(Line->Chars[i + j] == '_' || Line->Chars[i + j] == '\''))
) j++;
if (BF->GetHilitWord(j, &Line->Chars[i], Color)) {
//Color = hcPERL_Keyword;
State = hsPerl_Keyword;
} else {
int x;
x = i + j;
while ((x < Line->Count) &&
((Line->Chars[x] == ' ') || (Line->Chars[x] == 9))) x++;
if ((x < Line->Count) && (Line->Chars[x] == '(')) {
Color = Colors[CLR_Function];
} else {
Color = Colors[CLR_Normal];
}
State = hsPerl_Normal;
}
if (j == 1) {
if (*p == 'q') op = opQ;
else if (*p == 's' || *p == 'y') op = opS;
else if (*p == 'm') op = opM;
} else if (j == 2) {
if (*p == 'q') {
if (*p == 'q') op = opQQ;
else if (*p == 'w') op = opQW;
else if (*p == 'x') op = opQX;
} else if (*p == 't' && p[1] == 'r') op = opTR;
}
if (StateMap)
memset(StateMap + i, State, j);
if (B)
MoveMem(B, C - Pos, Width, Line->Chars + i, Color, j);
i += j;
len -= j;
p += j;
C += j;
switch (op) {
case opQ:
State = hsPerl_Quote1Op; // q{} operator
Color = Colors[CLR_Punctuation];
continue;
case opQQ:
case opQW:
case opQX:
State = hsPerl_Quote1Op; // qq{} qx{} qw{} operators
Color = Colors[CLR_Punctuation];
continue;
case opM:
State = hsPerl_Regexp1Op; // m{} operator
Color = Colors[CLR_Punctuation];
continue;
case opTR:
State = hsPerl_Regexp2Op; // tr{} operators
Color = Colors[CLR_RegexpDelim];
continue;
case opS:
State = hsPerl_Regexp2Op; // s{}{} operator
Color = Colors[CLR_Punctuation];
continue;
default:
State = hsPerl_Normal;
continue;
}
} else if (len >= 2 && ((*p == '-' && p[1] == '-') || (*p == '+' && p[1] == '+'))) {
hlState s = State;
State = hsPerl_Punct;
Color = Colors[CLR_Punctuation];
ColorNext();
ColorNext();
State = s;
continue;
} else if (len >= 2 && *p == '&' && (p[1] == '&' || isspace(p[1]))) {
State = hsPerl_Punct;
Color = Colors[CLR_Punctuation];
ColorNext();
ColorNext();
State = hsPerl_Normal;
continue;
} else if (*p == '&' && (len < 2 || p[1] != '&') && X_NOT(State)) {
State = hsPerl_Function;
Color = Colors[CLR_Function];
ColorNext();
while ((len > 0) && (*p == '$' ||
*p == '@' ||
*p == '*' ||
*p == '%' ||
*p == '\\'))
ColorNext();
while ((len > 0) && (isalnum(*p) ||
*p == '_' ||
*p == '\''))
ColorNext();
State = hsPerl_Normal | X_BIT;
continue;
} else if ((*p == '$') && (len > 1) &&
((p[1] == '$') || p[1] == '"')) {
State = hsPerl_Variable;
Color = Colors[CLR_Variable];
ColorNext();
ColorNext();
State = hsPerl_Normal | X_BIT;
continue;
} else if (*p == '$' || *p == '@' || *p == '\\' || (len > 2 && (*p == '%' || *p == '*') && X_NOT(State))) {
State = hsPerl_Variable;
Color = Colors[CLR_Variable];
ColorNext();
while ((len > 0) && ((*p == ' ') || (*p == '\t'))) {
IF_TAB() else
ColorNext();
}
while ((len > 0) && (*p == '$' ||
*p == '@' ||
*p == '*' ||
*p == '%' ||
*p == '\\'))
ColorNext();
if (len > 0 && *p != '{' && *p != ' ' && *p != '\t' && *p != '"' && *p != '\'')
ColorNext();
while ((len > 0) && (isalnum(*p) ||
*p == '_' ||
*p == '\''))
ColorNext();
State = hsPerl_Normal | X_BIT;
continue;
} else if ((len >= 2) && (*p == '0') && (*(p+1) == 'x')) {
State = hsPerl_Number;
Color = Colors[CLR_Number];
ColorNext();
ColorNext();
while (len && (isxdigit(*p) || *p == '_')) ColorNext();
// if (len && (toupper(*p) == 'U')) ColorNext();
// if (len && (toupper(*p) == 'L')) ColorNext();
State = hsPerl_Normal | X_BIT;
continue;
} else if (isdigit(*p)) {
State = hsPerl_Number;
Color = Colors[CLR_Number];
ColorNext();
while (len && (isdigit(*p) || (*p == 'e' || *p == 'E' || *p == '_'))) ColorNext();
// if (len && (toupper(*p) == 'U')) ColorNext();
// if (len && (toupper(*p) == 'L')) ColorNext();
State = hsPerl_Normal | X_BIT;
continue;
} else if (*p == '\'') {
State = QSET(hsPerl_String1, '\'');
Color = Colors[CLR_String];
goto hilit;
} else if (*p == '"') {
State = QSET(hsPerl_String2, '"');
Color = Colors[CLR_String];
goto hilit;
} else if (*p == '<' && len > 2 && p[1] == '<' &&
(p[2] == '"' || p[2] == '\'' || p[2] == '_' || (toupper(p[2]) >= 'A' && toupper(p[2]) <= 'Z')))
{
int hereDocKeyLen;
setHereDoc++;
for (hereDocKeyLen = 0;
hereDocKeyLen < len && (
p[2 + hereDocKeyLen] == '_' ||
(toupper(p[2 + hereDocKeyLen]) >= 'A' && toupper(p[2 + hereDocKeyLen]) <= 'Z')
);
++hereDocKeyLen)
{
hereDocKey[hereDocKeyLen] = p[2 + hereDocKeyLen];
}
hereDocKey[hereDocKeyLen] = '\0';
State = hsPerl_Punct;
Color = Colors[CLR_Punctuation];
ColorNext();
State = hsPerl_Normal;
continue;
} else if (*p == '`') {
State = QSET(hsPerl_StringBk, '`');
Color = Colors[CLR_String];
goto hilit;
} else if (*p == '#') {
State = hsPerl_Comment | (State & X_BIT);
continue;
} else if (X_NOT(State) && *p == '/') {
State = QSET(hsPerl_Regexp1, '/');
Color = Colors[CLR_RegexpDelim];
goto hilit;
} else if (X_NOT(State) &&
*p == '-' &&
len >= 2 &&
isalpha(p[1])
) {
Color = Colors[CLR_Normal]; // default.
if (strchr("wrxoRWXOezsfdlpSbctugkTB", p[1]) != NULL) {
Color = Colors[CLR_Punctuation]; // new default.
if (len > 2) {
switch(p[2]) {
case '_': // there may be others...
Color = Colors[CLR_Normal];
break;
default:
if (isalnum(p[2]))
Color = Colors[CLR_Normal];
break;
}
}
}
ColorNext();
ColorNext();
State = hsPerl_Normal;
continue;
} else if (*p == ')' || *p == ']') {
State = hsPerl_Punct;
Color = Colors[CLR_Punctuation];
ColorNext();
State = hsPerl_Normal | X_BIT;
continue;
} else if (ispunct(*p)) {
State = hsPerl_Punct;
Color = Colors[CLR_Punctuation];
ColorNext();
State = hsPerl_Normal;
continue;
}
Color = Colors[CLR_Normal];
goto hilit;
case hsPerl_Quote1Op:
if (*p != ' ' && !kwd(*p)) {
if (IS_OBRACE(*p))
State = QSET(hsPerl_Quote1M,
(1U << 2) | NUM_BRACE(*p));
else
State = QSET(hsPerl_Quote1, *p);
Color = Colors[CLR_QuoteDelim];
goto hilit;
} else if (kwd(*p)) {
State = hsPerl_Normal | X_BIT;
continue;
}
Color = Colors[CLR_Punctuation];
goto hilit;
case hsPerl_Quote1:
Color = Colors[CLR_String];
if ((len >= 2) && (*p == '\\')) {
goto hilit2;
} else if (*p == QCHAR(State)) {
Color = Colors[CLR_QuoteDelim];
ColorNext();
State = hsPerl_Normal | X_BIT;
continue;
}
goto hilit;
case hsPerl_Quote1M:
Color = Colors[CLR_String];
if ((len >= 2) && (*p == '\\')) {
goto hilit2;
} else if (GET_BRACE(QCHAR(State) & 3) == *p) {
State += 1 << (2 + 8);
goto hilit;
} else if (IS_MBRACE(GET_BRACE(QCHAR(State) & 3), *p)) {
State -= 1 << (2 + 8);
if ((QCHAR(State) >> 2) == 0) {
Color = Colors[CLR_QuoteDelim];
ColorNext();
State = hsPerl_Normal | X_BIT;
} else
goto hilit;
continue;
}
goto hilit;
case hsPerl_Regexp1Op:
if (*p != ' ' && !kwd(*p)) {
if (IS_OBRACE(*p))
State = QSET(hsPerl_Regexp1M,
(1U << 2) | NUM_BRACE(*p));
else
State = QSET(hsPerl_Regexp1, *p);
Color = Colors[CLR_RegexpDelim];
goto hilit;
} else if (kwd(*p)) {
State = hsPerl_Normal | X_BIT;
continue;
}
Color = Colors[CLR_Regexp];
goto hilit;
case hsPerl_Regexp1:
Color = Colors[CLR_Regexp];
if ((len >= 2) && (*p == '\\')) {
goto hilit2;
} else if (*p == QCHAR(State)) {
Color = Colors[CLR_RegexpDelim];
ColorNext();
Color = Colors[CLR_Punctuation];
while (len > 0 && isalpha(*p))
ColorNext();
State = hsPerl_Normal | X_BIT;
continue;
}
goto hilit;
case hsPerl_Regexp1M:
Color = Colors[CLR_Regexp];
if ((len >= 2) && (*p == '\\')) {
goto hilit2;
} else if (GET_BRACE(QCHAR(State) & 3) == *p) {
State += 1 << (2 + 8);
goto hilit;
} else if (IS_MBRACE(GET_BRACE(QCHAR(State) & 3), *p)) {
State -= 1 << (2 + 8);
if ((QCHAR(State) >> 2) == 0) {
Color = Colors[CLR_RegexpDelim];
ColorNext();
Color = Colors[CLR_Punctuation];
while (len > 0 && isalpha(*p))
ColorNext();
State = hsPerl_Normal | X_BIT;
} else
goto hilit;
continue;
}
goto hilit;
case hsPerl_Regexp2Op:
if (*p != ' ' && !kwd(*p)) {
if (IS_OBRACE(*p))
State = QSET(hsPerl_Regexp2M,
(1U << 2) | NUM_BRACE(*p));
else
State = QSET(hsPerl_Regexp2, *p);
Color = Colors[CLR_RegexpDelim];
goto hilit;
} else if (kwd(*p)) {
State = hsPerl_Normal | X_BIT;
continue;
}
Color = Colors[CLR_Regexp];
goto hilit;
case hsPerl_Regexp2:
Color = Colors[CLR_Regexp];
if ((len >= 2) && (*p == '\\')) {
goto hilit2;
} else if (*p == QCHAR(State)) {
Color = Colors[CLR_RegexpDelim];
ColorNext();
/*State = hsPerl_Normal | X_BIT;*/
State = QSET(hsPerl_Regexp1, QCHAR(State));
continue;
}
goto hilit;
case hsPerl_Regexp2M:
Color = Colors[CLR_Regexp];
if ((len >= 2) && (*p == '\\')) {
goto hilit2;
} else if (GET_BRACE(QCHAR(State) & 3) == *p) {
State += 1 << (2 + 8);
goto hilit;
} else if (IS_MBRACE(GET_BRACE(QCHAR(State) & 3), *p)) {
State -= 1 << (2 + 8);
if ((QCHAR(State) >> 2) == 0) {
Color = Colors[CLR_RegexpDelim];
ColorNext();
/*State = hsPerl_Normal | X_BIT;*/
State = hsPerl_Regexp1Op;
} else
goto hilit;
continue;
}
goto hilit;
case hsPerl_Data:
Color = Colors[CLR_Comment];
goto hilit;
case hsPerl_HereDoc:
if (!isEOHereDoc)
{
Color = Colors[CLR_String];
goto hilit;
}
Color = Colors[CLR_Punctuation];
setHereDoc = QCHAR(State);
while (len > 0)
ColorNext();
State = hsPerl_Normal | (State & X_BIT);
continue;
case hsPerl_Docs:
Color = Colors[CLR_Comment];
if (i == 0 && *p == '=' && len > 3 &&
p[1] == 'c' && p[2] == 'u' && p[3] == 't')
{
ColorNext();
ColorNext();
ColorNext();
ColorNext();
State = hsPerl_Normal;
Color = Colors[CLR_Normal];
continue;
}
goto hilit;
case hsPerl_Comment:
Color = Colors[CLR_Comment];
goto hilit;
case hsPerl_String1:
Color = Colors[CLR_String];
if ((len >= 2) && (*p == '\\')) {
goto hilit2;
} else if (*p == QCHAR(State)) {
ColorNext();
State = hsPerl_Normal | X_BIT;
continue;
}
goto hilit;
case hsPerl_String2:
Color = Colors[CLR_String];
if ((len >= 2) && (*p == '\\')) {
goto hilit2;
} else if (*p == QCHAR(State)) {
ColorNext();
State = hsPerl_Normal | X_BIT;
continue;
}
goto hilit;
case hsPerl_StringBk:
Color = Colors[CLR_String];
if ((len >= 2) && (*p == '\\')) {
goto hilit2;
} else if (*p == QCHAR(State)) {
ColorNext();
State = hsPerl_Normal | X_BIT;
continue;
}
goto hilit;
}
}
}
if ((State & X_MASK) == hsPerl_Comment)
State = hsPerl_Normal | (State & X_BIT);
if (setHereDoc)
State = QSET(hsPerl_HereDoc | (State & X_BIT), setHereDoc - 1);
*ECol = C;
return 0;
}
#endif