// Scintilla source code edit control /** @file LexPerl.cxx ** Lexer for subset of Perl. **/ // Copyright 1998-2001 by Neil Hodgson // The License.txt file describes the conditions under which this software may be distributed. #include #include #include #include #include #include "Platform.h" #include "PropSet.h" #include "Accessor.h" #include "KeyWords.h" #include "Scintilla.h" #include "SciLexer.h" static inline bool isEOLChar(char ch) { return (ch == '\r') || (ch == '\n'); } static bool isSingleCharOp(char ch) { char strCharSet[2]; strCharSet[0] = ch; strCharSet[1] = '\0'; return (NULL != strstr("rwxoRWXOezsfdlpSbctugkTBMAC", strCharSet)); } static inline bool isPerlOperator(char ch) { if (isalnum(ch)) return false; // '.' left out as it is used to make up numbers if (ch == '%' || ch == '^' || ch == '&' || ch == '*' || ch == '\\' || ch == '(' || ch == ')' || ch == '-' || ch == '+' || ch == '=' || ch == '|' || ch == '{' || ch == '}' || ch == '[' || ch == ']' || ch == ':' || ch == ';' || ch == '<' || ch == '>' || ch == ',' || ch == '/' || ch == '?' || ch == '!' || ch == '.' || ch == '~') return true; return false; } static int classifyWordPerl(unsigned int start, unsigned int end, WordList &keywords, Accessor &styler) { char s[100]; bool wordIsNumber = isdigit(styler[start]) || (styler[start] == '.'); for (unsigned int i = 0; i < end - start + 1 && i < 30; i++) { s[i] = styler[start + i]; s[i + 1] = '\0'; } char chAttr = SCE_PL_IDENTIFIER; if (wordIsNumber) chAttr = SCE_PL_NUMBER; else { if (keywords.InList(s)) chAttr = SCE_PL_WORD; } styler.ColourTo(end, chAttr); return chAttr; } static inline bool isEndVar(char ch) { return !isalnum(ch) && ch != '#' && ch != '$' && ch != '_' && ch != '\''; } static bool isMatch(Accessor &styler, int lengthDoc, int pos, const char *val) { if ((pos + static_cast(strlen(val))) >= lengthDoc) { return false; } while (*val) { if (*val != styler[pos++]) { return false; } val++; } return true; } static char opposite(char ch) { if (ch == '(') return ')'; if (ch == '[') return ']'; if (ch == '{') return '}'; if (ch == '<') return '>'; return ch; } static void ColourisePerlDoc(unsigned int startPos, int length, int initStyle, WordList *keywordlists[], Accessor &styler) { // Lexer for perl often has to backtrack to start of current style to determine // which characters are being used as quotes, how deeply nested is the // start position and what the termination string is for here documents WordList &keywords = *keywordlists[0]; class HereDocCls { public: int State; // 0: '<<' encountered // 1: collect the delimiter // 2: here doc text (lines after the delimiter) char Quote; // the char after '<<' bool Quoted; // true if Quote in ('\'','"','`') int DelimiterLength; // strlen(Delimiter) char Delimiter[256]; // the Delimiter, 256: sizeof PL_tokenbuf HereDocCls() { State = 0; DelimiterLength = 0; Delimiter[0] = '\0'; } }; HereDocCls HereDoc; // TODO: FIFO for stacked here-docs class QuoteCls { public: int Rep; int Count; char Up; char Down; QuoteCls() { this->New(1); } void New(int r) { Rep = r; Count = 0; Up = '\0'; Down = '\0'; } void Open(char u) { Count++; Up = u; Down = opposite(Up); } }; QuoteCls Quote; char sooked[100]; int sookedpos = 0; bool preferRE = true; sooked[sookedpos] = '\0'; int state = initStyle; unsigned int lengthDoc = startPos + length; // If in a long distance lexical state, seek to the beginning to find quote characters if (state == SCE_PL_HERE_Q || state == SCE_PL_HERE_QQ || state == SCE_PL_HERE_QX) { while ((startPos > 1) && (styler.StyleAt(startPos) != SCE_PL_HERE_DELIM)) { startPos--; } startPos = styler.LineStart(styler.GetLine(startPos)); state = styler.StyleAt(startPos - 1); } if ( state == SCE_PL_STRING_Q || state == SCE_PL_STRING_QQ || state == SCE_PL_STRING_QX || state == SCE_PL_STRING_QR || state == SCE_PL_STRING_QW || state == SCE_PL_REGEX || state == SCE_PL_REGSUBST ) { while ((startPos > 1) && (styler.StyleAt(startPos - 1) == state)) { startPos--; } state = SCE_PL_DEFAULT; } styler.StartAt(startPos); char chPrev = styler.SafeGetCharAt(startPos - 1); if (startPos == 0) chPrev = '\n'; char chNext = styler[startPos]; styler.StartSegment(startPos); for (unsigned int i = startPos; i < lengthDoc; i++) { char ch = chNext; chNext = styler.SafeGetCharAt(i + 1); char chNext2 = styler.SafeGetCharAt(i + 2); if (styler.IsLeadByte(ch)) { chNext = styler.SafeGetCharAt(i + 2); chPrev = ' '; i += 1; continue; } if ((chPrev == '\r' && ch == '\n')) { // skip on DOS/Windows chPrev = ch; continue; } if (HereDoc.State == 1 && isEOLChar(ch)) { // Begin of here-doc (the line after the here-doc delimiter): HereDoc.State = 2; styler.ColourTo(i - 1, state); if (HereDoc.Quoted) { if (state == SCE_PL_HERE_DELIM) { // Missing quote at end of string! We are stricter than perl. state = SCE_PL_ERROR; } else { switch (HereDoc.Quote) { case '\'': state = SCE_PL_HERE_Q ; break; case '"': state = SCE_PL_HERE_QQ; break; case '`': state = SCE_PL_HERE_QX; break; } } } else { switch (HereDoc.Quote) { case '\\': state = SCE_PL_HERE_Q ; break; default : state = SCE_PL_HERE_QQ; } } } if (state == SCE_PL_DEFAULT) { if (iswordstart(ch)) { styler.ColourTo(i - 1, state); if (ch == 's' && !isalnum(chNext)) { state = SCE_PL_REGSUBST; Quote.New(2); } else if (ch == 'm' && !isalnum(chNext)) { state = SCE_PL_REGEX; Quote.New(1); } else if (ch == 'q' && !isalnum(chNext)) { state = SCE_PL_STRING_Q; Quote.New(1); } else if (ch == 'y' && !isalnum(chNext)) { state = SCE_PL_REGSUBST; Quote.New(2); } else if (ch == 't' && chNext == 'r' && !isalnum(chNext2)) { state = SCE_PL_REGSUBST; Quote.New(2); i++; chNext = chNext2; } else if (ch == 'q' && (chNext == 'q' || chNext == 'r' || chNext == 'w' || chNext == 'x') && !isalnum(chNext2)) { if (chNext == 'q') state = SCE_PL_STRING_QQ; else if (chNext == 'x') state = SCE_PL_STRING_QX; else if (chNext == 'r') state = SCE_PL_STRING_QR; else if (chNext == 'w') state = SCE_PL_STRING_QW; i++; chNext = chNext2; Quote.New(1); } else { state = SCE_PL_WORD; preferRE = false; if ((!iswordchar(chNext) && chNext != '\'') || (chNext == '.' && chNext2 == '.')) { // We need that if length of word == 1! // This test is copied from the SCE_PL_WORD handler. classifyWordPerl(styler.GetStartSegment(), i, keywords, styler); state = SCE_PL_DEFAULT; } } } else if (ch == '#') { styler.ColourTo(i - 1, state); state = SCE_PL_COMMENTLINE; } else if (ch == '\"') { styler.ColourTo(i - 1, state); state = SCE_PL_STRING; Quote.New(1); Quote.Open(ch); } else if (ch == '\'') { if (chPrev == '&') { // Archaic call styler.ColourTo(i, state); } else { styler.ColourTo(i - 1, state); state = SCE_PL_CHARACTER; Quote.New(1); Quote.Open(ch); } } else if (ch == '`') { styler.ColourTo(i - 1, state); state = SCE_PL_BACKTICKS; Quote.New(1); Quote.Open(ch); } else if (ch == '$') { preferRE = false; styler.ColourTo(i - 1, state); if ((chNext == '{') || isspacechar(chNext)) { styler.ColourTo(i, SCE_PL_SCALAR); } else { state = SCE_PL_SCALAR; i++; ch = chNext; chNext = chNext2; } } else if (ch == '@') { preferRE = false; styler.ColourTo(i - 1, state); if (isalpha(chNext) || chNext == '#' || chNext == '$' || chNext == '_') { state = SCE_PL_ARRAY; } else if (chNext != '{' && chNext != '[') { styler.ColourTo(i, SCE_PL_ARRAY); i++; HTTP/1.1 200 OK Connection: keep-alive Connection: keep-alive Content-Disposition: inline; filename="LexPerl.cxx" Content-Disposition: inline; filename="LexPerl.cxx" Content-Length: 18930 Content-Length: 18930 Content-Security-Policy: default-src 'none' Content-Security-Policy: default-src 'none' Content-Type: text/plain; charset=UTF-8 Content-Type: text/plain; charset=UTF-8 Date: Sun, 19 Oct 2025 09:09:43 UTC ETag: "590d05d2a3de5dd9c526a7d025a58db6c6ecd220" ETag: "590d05d2a3de5dd9c526a7d025a58db6c6ecd220" Expires: Wed, 17 Oct 2035 09:09:43 GMT Expires: Wed, 17 Oct 2035 09:09:43 GMT Last-Modified: Sun, 19 Oct 2025 09:09:43 GMT Last-Modified: Sun, 19 Oct 2025 09:09:43 GMT Server: OpenBSD httpd Server: OpenBSD httpd X-Content-Type-Options: nosniff X-Content-Type-Options: nosniff // Scintilla source code edit control /** @file LexPerl.cxx ** Lexer for subset of Perl. **/ // Copyright 1998-2001 by Neil Hodgson // The License.txt file describes the conditions under which this software may be distributed. #include #include #include #include #include #include "Platform.h" #include "PropSet.h" #include "Accessor.h" #include "KeyWords.h" #include "Scintilla.h" #include "SciLexer.h" static inline bool isEOLChar(char ch) { return (ch == '\r') || (ch == '\n'); } static bool isSingleCharOp(char ch) { char strCharSet[2]; strCharSet[0] = ch; strCharSet[1] = '\0'; return (NULL != strstr("rwxoRWXOezsfdlpSbctugkTBMAC", strCharSet)); } static inline bool isPerlOperator(char ch) { if (isalnum(ch)) return false; // '.' left out as it is used to make up numbers if (ch == '%' || ch == '^' || ch == '&' || ch == '*' || ch == '\\' || ch == '(' || ch == ')' || ch == '-' || ch == '+' || ch == '=' || ch == '|' || ch == '{' || ch == '}' || ch == '[' || ch == ']' || ch == ':' || ch == ';' || ch == '<' || ch == '>' || ch == ',' || ch == '/' || ch == '?' || ch == '!' || ch == '.' || ch == '~') return true; return false; } static int classifyWordPerl(unsigned int start, unsigned int end, WordList &keywords, Accessor &styler) { char s[100]; bool wordIsNumber = isdigit(styler[start]) || (styler[start] == '.'); for (unsigned int i = 0; i < end - start + 1 && i < 30; i++) { s[i] = styler[start + i]; s[i + 1] = '\0'; } char chAttr = SCE_PL_IDENTIFIER; if (wordIsNumber) chAttr = SCE_PL_NUMBER; else { if (keywords.InList(s)) chAttr = SCE_PL_WORD; } styler.ColourTo(end, chAttr); return chAttr; } static inline bool isEndVar(char ch) { return !isalnum(ch) && ch != '#' && ch != '$' && ch != '_' && ch != '\''; } static bool isMatch(Accessor &styler, int lengthDoc, int pos, const char *val) { if ((pos + static_cast(strlen(val))) >= lengthDoc) { return false; } while (*val) { if (*val != styler[pos++]) { return false; } val++; } return true; } static char opposite(char ch) { if (ch == '(') return ')'; if (ch == '[') return ']'; if (ch == '{') return '}'; if (ch == '<') return '>'; return ch; } static void ColourisePerlDoc(unsigned int startPos, int length, int initStyle, WordList *keywordlists[], Accessor &styler) { // Lexer for perl often has to backtrack to start of current style to determine // which characters are being used as quotes, how deeply nested is the // start position and what the termination string is for here documents WordList &keywords = *keywordlists[0]; class HereDocCls { public: int State; // 0: '<<' encountered // 1: collect the delimiter // 2: here doc text (lines after the delimiter) char Quote; // the char after '<<' bool Quoted; // true if Quote in ('\'','"','`') int DelimiterLength; // strlen(Delimiter) char Delimiter[256]; // the Delimiter, 256: sizeof PL_tokenbuf HereDocCls() { State = 0; DelimiterLength = 0; Delimiter[0] = '\0'; } }; HereDocCls HereDoc; // TODO: FIFO for stacked here-docs class QuoteCls { public: int Rep; int Count; char Up; char Down; QuoteCls() { this->New(1); } void New(int r) { Rep = r; Count = 0; Up = '\0'; Down = '\0'; } void Open(char u) { Count++; Up = u; Down = opposite(Up); } }; QuoteCls Quote; char sooked[100]; int sookedpos = 0; bool preferRE = true; sooked[sookedpos] = '\0'; int state = initStyle; unsigned int lengthDoc = startPos + length; // If in a long distance lexical state, seek to the beginning to find quote characters if (state == SCE_PL_HERE_Q || state == SCE_PL_HERE_QQ || state == SCE_PL_HERE_QX) { while ((startPos > 1) && (styler.StyleAt(startPos) != SCE_PL_HERE_DELIM)) { startPos--; } startPos = styler.LineStart(styler.GetLine(startPos)); state = styler.StyleAt(startPos - 1); } if ( state == SCE_PL_STRING_Q || state == SCE_PL_STRING_QQ || state == SCE_PL_STRING_QX || state == SCE_PL_STRING_QR || state == SCE_PL_STRING_QW || state == SCE_PL_REGEX || state == SCE_PL_REGSUBST ) { while ((startPos > 1) && (styler.StyleAt(startPos - 1) == state)) { startPos--; } state = SCE_PL_DEFAULT; } styler.StartAt(startPos); char chPrev = styler.SafeGetCharAt(startPos - 1); if (startPos == 0) chPrev = '\n'; char chNext = styler[startPos]; styler.StartSegment(startPos); for (unsigned int i = startPos; i < lengthDoc; i++) { char ch = chNext; chNext = styler.SafeGetCharAt(i + 1); char chNext2 = styler.SafeGetCharAt(i + 2); if (styler.IsLeadByte(ch)) { chNext = styler.SafeGetCharAt(i + 2); chPrev = ' '; i += 1; continue; } if ((chPrev == '\r' && ch == '\n')) { // skip on DOS/Windows chPrev = ch; continue; } if (HereDoc.State == 1 && isEOLChar(ch)) { // Begin of here-doc (the line after the here-doc delimiter): HereDoc.State = 2; styler.ColourTo(i - 1, state); if (HereDoc.Quoted) { if (state == SCE_PL_HERE_DELIM) { // Missing quote at end of string! We are stricter than perl. state = SCE_PL_ERROR; } else { switch (HereDoc.Quote) { case '\'': state = SCE_PL_HERE_Q ; break; case '"': state = SCE_PL_HERE_QQ; break; case '`': state = SCE_PL_HERE_QX; break; } } } else { switch (HereDoc.Quote) { case '\\': state = SCE_PL_HERE_Q ; break; default : state = SCE_PL_HERE_QQ; } } } if (state == SCE_PL_DEFAULT) { if (iswordstart(ch)) { styler.ColourTo(i - 1, state); if (ch == 's' && !isalnum(chNext)) { state = SCE_PL_REGSUBST; Quote.New(2); } else if (ch == 'm' && !isalnum(chNext)) { state = SCE_PL_REGEX; Quote.New(1); } else if (ch == 'q' && !isalnum(chNext)) { state = SCE_PL_STRING_Q; Quote.New(1); } else if (ch == 'y' && !isalnum(chNext)) { state = SCE_PL_REGSUBST; Quote.New(2); } else if (ch == 't' && chNext == 'r' && !isalnum(chNext2)) { state = SCE_PL_REGSUBST; Quote.New(2); i++; chNext = chNext2; } else if (ch == 'q' && (chNext == 'q' || chNext == 'r' || chNext == 'w' || chNext == 'x') && !isalnum(chNext2)) { if (chNext == 'q') state = SCE_PL_STRING_QQ; else if (chNext == 'x') state = SCE_PL_STRING_QX; else if (chNext == 'r') state = SCE_PL_STRING_QR; else if (chNext == 'w') state = SCE_PL_STRING_QW; i++; chNext = chNext2; Quote.New(1); } else { state = SCE_PL_WORD; preferRE = false; if ((!iswordchar(chNext) && chNext != '\'') || (chNext == '.' && chNext2 == '.')) { // We need that if length of word == 1! // This test is copied from the SCE_PL_WORD handler. classifyWordPerl(styler.GetStartSegment(), i, keywords, styler); state = SCE_PL_DEFAULT; } } } else if (ch == '#') { styler.ColourTo(i - 1, state); state = SCE_PL_COMMENTLINE; } else if (ch == '\"') { styler.ColourTo(i - 1, state); state = SCE_PL_STRING; Quote.New(1); Quote.Open(ch); } else if (ch == '\'') { if (chPrev == '&') { // Archaic call styler.ColourTo(i, state); } else { styler.ColourTo(i - 1, state); state = SCE_PL_CHARACTER; Quote.New(1); Quote.Open(ch); } } else if (ch == '`') { styler.ColourTo(i - 1, state); state = SCE_PL_BACKTICKS; Quote.New(1); Quote.Open(ch); } else if (ch == '$') { preferRE = false; styler.ColourTo(i - 1, state); if ((chNext == '{') || isspacechar(chNext)) { styler.ColourTo(i, SCE_PL_SCALAR); } else { state = SCE_PL_SCALAR; i++; ch = chNext; chNext = chNext2; } } else if (ch == '@') { preferRE = false; styler.ColourTo(i - 1, state); if (isalpha(chNext) || chNext == '#' || chNext == '$' || chNext == '_') { state = SCE_PL_ARRAY; } else if (chNext != '{' && chNext != '[') { styler.ColourTo(i, SCE_PL_ARRAY); i++; ch = ' '; } else { styler.ColourTo(i, SCE_PL_ARRAY); } } else if (ch == '%') { preferRE = false; styler.ColourTo(i - 1, state); if (isalpha(chNext) || chNext == '#' || chNext == '$' || chNext == '_') { state = SCE_PL_HASH; } else if (chNext == '{') { styler.ColourTo(i, SCE_PL_HASH); } else { styler.ColourTo(i, SCE_PL_OPERATOR); } } else if (ch == '*') { styler.ColourTo(i - 1, state); state = SCE_PL_SYMBOLTABLE; } else if (ch == '/' && preferRE) { styler.ColourTo(i - 1, state); state = SCE_PL_REGEX; Quote.New(1); Quote.Open(ch); } else if (ch == '<' && chNext == '<') { styler.ColourTo(i - 1, state); state = SCE_PL_HERE_DELIM; HereDoc.State = 0; } else if (ch == '=' && isalpha(chNext) && (isEOLChar(chPrev))) { styler.ColourTo(i - 1, state); state = SCE_PL_POD; sookedpos = 0; sooked[sookedpos] = '\0'; } else if (ch == '-' && isSingleCharOp(chNext) && !isalnum((chNext2 = styler.SafeGetCharAt(i+2)))) { styler.ColourTo(i - 1, state); styler.ColourTo(i + 1, SCE_PL_WORD); state = SCE_PL_DEFAULT; preferRE = false; i += 2; ch = chNext2; chNext = chNext2 = styler.SafeGetCharAt(i + 1); } else if (isPerlOperator(ch)) { if (ch == ')' || ch == ']') preferRE = false; else preferRE = true; styler.ColourTo(i - 1, state); styler.ColourTo(i, SCE_PL_OPERATOR); } } else if (state == SCE_PL_WORD) { if ((!iswordchar(chNext) && chNext != '\'') || (chNext == '.' && chNext2 == '.')) { // ".." is always an operator if preceded by a SCE_PL_WORD. // Archaic Perl has quotes inside na