599 lines
23 KiB
C++
599 lines
23 KiB
C++
/* 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
|