1 // Scintilla source code edit control
2 /** @file LexPascal.cxx
4 ** Written by Laurent le Tynevez
5 ** Updated by Simon Steele <s.steele@pnotepad.org> September 2002
6 ** Updated by Mathias Rauen <scite@madshi.net> May 2003 (Delphi adjustments)
7 ** Completely rewritten by Marko Njezic <sf@maxempire.com> October 2008
12 A few words about features of the new completely rewritten LexPascal...
14 Generally speaking LexPascal tries to support all available Delphi features (up
15 to Delphi 2009 at this time), including .NET specific features.
19 If you enable "lexer.pascal.smart.highlighting" property, some keywords will
20 only be highlighted in appropriate context. As implemented those are keywords
21 related to property and DLL exports declarations (similar to how Delphi IDE
24 For example, keywords "read" and "write" will only be highlighted if they are in
27 property MyProperty: boolean read FMyProperty write FMyProperty;
31 Folding is supported in the following cases:
33 - Folding of stream-like comments
34 - Folding of groups of consecutive line comments
35 - Folding of preprocessor blocks (the following preprocessor blocks are
36 supported: IF / IFEND; IFDEF, IFNDEF, IFOPT / ENDIF and REGION / ENDREGION
37 blocks), including nesting of preprocessor blocks up to 255 levels
38 - Folding of code blocks on appropriate keywords (the following code blocks are
39 supported: "begin, asm, record, try, case / end" blocks, class & object
40 declarations and interface declarations)
44 - Folding of code blocks tries to handle all special cases in which folding
45 should not occur. As implemented those are:
47 1. Structure "record case / end" (there's only one "end" statement and "case" is
48 ignored as fold point)
49 2. Forward class declarations ("type TMyClass = class;") and object method
50 declarations ("TNotifyEvent = procedure(Sender: TObject) of object;") are
51 ignored as fold points
52 3. Simplified complete class declarations ("type TMyClass = class(TObject);")
53 are ignored as fold points
54 4. Every other situation when class keyword doesn't actually start class
55 declaration ("class procedure", "class function", "class of", "class var",
56 "class property" and "class operator")
57 5. Forward (disp)interface declarations ("type IMyInterface = interface;") are
58 ignored as fold points
60 - Folding of code blocks inside preprocessor blocks is disabled (any comments
61 inside them will be folded fine) because there is no guarantee that complete
62 code block will be contained inside folded preprocessor block in which case
63 folded code block could end prematurely at the end of preprocessor block if
64 there is no closing statement inside. This was done in order to properly process
65 document that may contain something like this:
69 TMyClass = class(UnicodeAncestor)
71 TMyClass = class(AnsiAncestor)
81 If class declarations were folded, then the second class declaration would end
82 at "$ENDIF" statement, first class statement would end at "end;" statement and
83 preprocessor "$IFDEF" block would go all the way to the end of document.
84 However, having in mind all this, if you want to enable folding of code blocks
85 inside preprocessor blocks, you can disable folding of preprocessor blocks by
86 changing "fold.preprocessor" property, in which case everything inside them
91 The list of keywords that can be used in pascal.properties file (up to Delphi
94 - Keywords: absolute abstract and array as asm assembler automated begin case
95 cdecl class const constructor deprecated destructor dispid dispinterface div do
96 downto dynamic else end except export exports external far file final
97 finalization finally for forward function goto if implementation in inherited
98 initialization inline interface is label library message mod near nil not object
99 of on or out overload override packed pascal platform private procedure program
100 property protected public published raise record register reintroduce repeat
101 resourcestring safecall sealed set shl shr static stdcall strict string then
102 threadvar to try type unit unsafe until uses var varargs virtual while with xor
104 - Keywords related to the "smart highlithing" feature: add default implements
105 index name nodefault read readonly remove stored write writeonly
107 - Keywords related to Delphi packages (in addition to all above): package
120 #include "Scintilla.h"
121 #include "SciLexer.h"
123 #include "WordList.h"
124 #include "LexAccessor.h"
125 #include "Accessor.h"
126 #include "StyleContext.h"
127 #include "CharacterSet.h"
128 #include "LexerModule.h"
131 using namespace Scintilla
;
134 static void GetRangeLowered(unsigned int start
,
140 while ((i
< end
- start
+ 1) && (i
< len
-1)) {
141 s
[i
] = static_cast<char>(tolower(styler
[start
+ i
]));
147 static void GetForwardRangeLowered(unsigned int start
,
148 CharacterSet
&charSet
,
153 while ((i
< len
-1) && charSet
.Contains(styler
.SafeGetCharAt(start
+ i
))) {
154 s
[i
] = static_cast<char>(tolower(styler
.SafeGetCharAt(start
+ i
)));
163 stateInProperty
= 0x2000,
164 stateInExport
= 0x4000,
165 stateFoldInPreprocessor
= 0x0100,
166 stateFoldInRecord
= 0x0200,
167 stateFoldInPreprocessorLevelMask
= 0x00FF,
168 stateFoldMaskAll
= 0x0FFF
171 static void ClassifyPascalWord(WordList
*keywordlists
[], StyleContext
&sc
, int &curLineState
, bool bSmartHighlighting
) {
172 WordList
& keywords
= *keywordlists
[0];
175 sc
.GetCurrentLowered(s
, sizeof(s
));
176 if (keywords
.InList(s
)) {
177 if (curLineState
& stateInAsm
) {
178 if (strcmp(s
, "end") == 0 && sc
.GetRelative(-4) != '@') {
179 curLineState
&= ~stateInAsm
;
180 sc
.ChangeState(SCE_PAS_WORD
);
182 sc
.ChangeState(SCE_PAS_ASM
);
185 bool ignoreKeyword
= false;
186 if (strcmp(s
, "asm") == 0) {
187 curLineState
|= stateInAsm
;
188 } else if (bSmartHighlighting
) {
189 if (strcmp(s
, "property") == 0) {
190 curLineState
|= stateInProperty
;
191 } else if (strcmp(s
, "exports") == 0) {
192 curLineState
|= stateInExport
;
193 } else if (!(curLineState
& (stateInProperty
| stateInExport
)) && strcmp(s
, "index") == 0) {
194 ignoreKeyword
= true;
195 } else if (!(curLineState
& stateInExport
) && strcmp(s
, "name") == 0) {
196 ignoreKeyword
= true;
197 } else if (!(curLineState
& stateInProperty
) &&
198 (strcmp(s
, "read") == 0 || strcmp(s
, "write") == 0 ||
199 strcmp(s
, "default") == 0 || strcmp(s
, "nodefault") == 0 ||
200 strcmp(s
, "stored") == 0 || strcmp(s
, "implements") == 0 ||
201 strcmp(s
, "readonly") == 0 || strcmp(s
, "writeonly") == 0 ||
202 strcmp(s
, "add") == 0 || strcmp(s
, "remove") == 0)) {
203 ignoreKeyword
= true;
206 if (!ignoreKeyword
) {
207 sc
.ChangeState(SCE_PAS_WORD
);
210 } else if (curLineState
& stateInAsm
) {
211 sc
.ChangeState(SCE_PAS_ASM
);
213 sc
.SetState(SCE_PAS_DEFAULT
);
216 static void ColourisePascalDoc(unsigned int startPos
, int length
, int initStyle
, WordList
*keywordlists
[],
218 bool bSmartHighlighting
= styler
.GetPropertyInt("lexer.pascal.smart.highlighting", 1) != 0;
220 CharacterSet
setWordStart(CharacterSet::setAlpha
, "_", 0x80, true);
221 CharacterSet
setWord(CharacterSet::setAlphaNum
, "_", 0x80, true);
222 CharacterSet
setNumber(CharacterSet::setDigits
, ".-+eE");
223 CharacterSet
setHexNumber(CharacterSet::setDigits
, "abcdefABCDEF");
224 CharacterSet
setOperator(CharacterSet::setNone
, "#$&'()*+,-./:;<=>@[]^{}");
226 int curLine
= styler
.GetLine(startPos
);
227 int curLineState
= curLine
> 0 ? styler
.GetLineState(curLine
- 1) : 0;
229 StyleContext
sc(startPos
, length
, initStyle
, styler
);
231 for (; sc
.More(); sc
.Forward()) {
233 // Update the line state, so it can be seen by next line
234 curLine
= styler
.GetLine(sc
.currentPos
);
235 styler
.SetLineState(curLine
, curLineState
);
238 // Determine if the current state should terminate.
241 if (!setNumber
.Contains(sc
.ch
) || (sc
.ch
== '.' && sc
.chNext
== '.')) {
242 sc
.SetState(SCE_PAS_DEFAULT
);
243 } else if (sc
.ch
== '-' || sc
.ch
== '+') {
244 if (sc
.chPrev
!= 'E' && sc
.chPrev
!= 'e') {
245 sc
.SetState(SCE_PAS_DEFAULT
);
249 case SCE_PAS_IDENTIFIER
:
250 if (!setWord
.Contains(sc
.ch
)) {
251 ClassifyPascalWord(keywordlists
, sc
, curLineState
, bSmartHighlighting
);
254 case SCE_PAS_HEXNUMBER
:
255 if (!setHexNumber
.Contains(sc
.ch
)) {
256 sc
.SetState(SCE_PAS_DEFAULT
);
259 case SCE_PAS_COMMENT
:
260 case SCE_PAS_PREPROCESSOR
:
262 sc
.ForwardSetState(SCE_PAS_DEFAULT
);
265 case SCE_PAS_COMMENT2
:
266 case SCE_PAS_PREPROCESSOR2
:
267 if (sc
.Match('*', ')')) {
269 sc
.ForwardSetState(SCE_PAS_DEFAULT
);
272 case SCE_PAS_COMMENTLINE
:
273 if (sc
.atLineStart
) {
274 sc
.SetState(SCE_PAS_DEFAULT
);
279 sc
.ChangeState(SCE_PAS_STRINGEOL
);
280 } else if (sc
.ch
== '\'' && sc
.chNext
== '\'') {
282 } else if (sc
.ch
== '\'') {
283 sc
.ForwardSetState(SCE_PAS_DEFAULT
);
286 case SCE_PAS_STRINGEOL
:
287 if (sc
.atLineStart
) {
288 sc
.SetState(SCE_PAS_DEFAULT
);
291 case SCE_PAS_CHARACTER
:
292 if (!setHexNumber
.Contains(sc
.ch
) && sc
.ch
!= '$') {
293 sc
.SetState(SCE_PAS_DEFAULT
);
296 case SCE_PAS_OPERATOR
:
297 if (bSmartHighlighting
&& sc
.chPrev
== ';') {
298 curLineState
&= ~(stateInProperty
| stateInExport
);
300 sc
.SetState(SCE_PAS_DEFAULT
);
303 sc
.SetState(SCE_PAS_DEFAULT
);
307 // Determine if a new state should be entered.
308 if (sc
.state
== SCE_PAS_DEFAULT
) {
309 if (IsADigit(sc
.ch
) && !(curLineState
& stateInAsm
)) {
310 sc
.SetState(SCE_PAS_NUMBER
);
311 } else if (setWordStart
.Contains(sc
.ch
)) {
312 sc
.SetState(SCE_PAS_IDENTIFIER
);
313 } else if (sc
.ch
== '$' && !(curLineState
& stateInAsm
)) {
314 sc
.SetState(SCE_PAS_HEXNUMBER
);
315 } else if (sc
.Match('{', '$')) {
316 sc
.SetState(SCE_PAS_PREPROCESSOR
);
317 } else if (sc
.ch
== '{') {
318 sc
.SetState(SCE_PAS_COMMENT
);
319 } else if (sc
.Match("(*$")) {
320 sc
.SetState(SCE_PAS_PREPROCESSOR2
);
321 } else if (sc
.Match('(', '*')) {
322 sc
.SetState(SCE_PAS_COMMENT2
);
323 sc
.Forward(); // Eat the * so it isn't used for the end of the comment
324 } else if (sc
.Match('/', '/')) {
325 sc
.SetState(SCE_PAS_COMMENTLINE
);
326 } else if (sc
.ch
== '\'') {
327 sc
.SetState(SCE_PAS_STRING
);
328 } else if (sc
.ch
== '#') {
329 sc
.SetState(SCE_PAS_CHARACTER
);
330 } else if (setOperator
.Contains(sc
.ch
) && !(curLineState
& stateInAsm
)) {
331 sc
.SetState(SCE_PAS_OPERATOR
);
332 } else if (curLineState
& stateInAsm
) {
333 sc
.SetState(SCE_PAS_ASM
);
338 if (sc
.state
== SCE_PAS_IDENTIFIER
&& setWord
.Contains(sc
.chPrev
)) {
339 ClassifyPascalWord(keywordlists
, sc
, curLineState
, bSmartHighlighting
);
345 static bool IsStreamCommentStyle(int style
) {
346 return style
== SCE_PAS_COMMENT
|| style
== SCE_PAS_COMMENT2
;
349 static bool IsCommentLine(int line
, Accessor
&styler
) {
350 int pos
= styler
.LineStart(line
);
351 int eolPos
= styler
.LineStart(line
+ 1) - 1;
352 for (int i
= pos
; i
< eolPos
; i
++) {
354 char chNext
= styler
.SafeGetCharAt(i
+ 1);
355 int style
= styler
.StyleAt(i
);
356 if (ch
== '/' && chNext
== '/' && style
== SCE_PAS_COMMENTLINE
) {
358 } else if (!IsASpaceOrTab(ch
)) {
365 static unsigned int GetFoldInPreprocessorLevelFlag(int lineFoldStateCurrent
) {
366 return lineFoldStateCurrent
& stateFoldInPreprocessorLevelMask
;
369 static void SetFoldInPreprocessorLevelFlag(int &lineFoldStateCurrent
, unsigned int nestLevel
) {
370 lineFoldStateCurrent
&= ~stateFoldInPreprocessorLevelMask
;
371 lineFoldStateCurrent
|= nestLevel
& stateFoldInPreprocessorLevelMask
;
374 static void ClassifyPascalPreprocessorFoldPoint(int &levelCurrent
, int &lineFoldStateCurrent
,
375 unsigned int startPos
, Accessor
&styler
) {
376 CharacterSet
setWord(CharacterSet::setAlpha
);
378 char s
[11]; // Size of the longest possible keyword + one additional character + null
379 GetForwardRangeLowered(startPos
, setWord
, styler
, s
, sizeof(s
));
381 unsigned int nestLevel
= GetFoldInPreprocessorLevelFlag(lineFoldStateCurrent
);
383 if (strcmp(s
, "if") == 0 ||
384 strcmp(s
, "ifdef") == 0 ||
385 strcmp(s
, "ifndef") == 0 ||
386 strcmp(s
, "ifopt") == 0 ||
387 strcmp(s
, "region") == 0) {
389 SetFoldInPreprocessorLevelFlag(lineFoldStateCurrent
, nestLevel
);
390 lineFoldStateCurrent
|= stateFoldInPreprocessor
;
392 } else if (strcmp(s
, "endif") == 0 ||
393 strcmp(s
, "ifend") == 0 ||
394 strcmp(s
, "endregion") == 0) {
396 SetFoldInPreprocessorLevelFlag(lineFoldStateCurrent
, nestLevel
);
397 if (nestLevel
== 0) {
398 lineFoldStateCurrent
&= ~stateFoldInPreprocessor
;
401 if (levelCurrent
< SC_FOLDLEVELBASE
) {
402 levelCurrent
= SC_FOLDLEVELBASE
;
407 static unsigned int SkipWhiteSpace(unsigned int currentPos
, unsigned int endPos
,
408 Accessor
&styler
, bool includeChars
= false) {
409 CharacterSet
setWord(CharacterSet::setAlphaNum
, "_");
410 unsigned int j
= currentPos
+ 1;
411 char ch
= styler
.SafeGetCharAt(j
);
412 while ((j
< endPos
) && (IsASpaceOrTab(ch
) || ch
== '\r' || ch
== '\n' ||
413 IsStreamCommentStyle(styler
.StyleAt(j
)) || (includeChars
&& setWord
.Contains(ch
)))) {
415 ch
= styler
.SafeGetCharAt(j
);
420 static void ClassifyPascalWordFoldPoint(int &levelCurrent
, int &lineFoldStateCurrent
,
421 int startPos
, unsigned int endPos
,
422 unsigned int lastStart
, unsigned int currentPos
, Accessor
&styler
) {
424 GetRangeLowered(lastStart
, currentPos
, styler
, s
, sizeof(s
));
426 if (strcmp(s
, "record") == 0) {
427 lineFoldStateCurrent
|= stateFoldInRecord
;
429 } else if (strcmp(s
, "begin") == 0 ||
430 strcmp(s
, "asm") == 0 ||
431 strcmp(s
, "try") == 0 ||
432 (strcmp(s
, "case") == 0 && !(lineFoldStateCurrent
& stateFoldInRecord
))) {
434 } else if (strcmp(s
, "class") == 0 || strcmp(s
, "object") == 0) {
435 // "class" & "object" keywords require special handling...
436 bool ignoreKeyword
= false;
437 unsigned int j
= SkipWhiteSpace(currentPos
, endPos
, styler
);
439 CharacterSet
setWordStart(CharacterSet::setAlpha
, "_");
440 CharacterSet
setWord(CharacterSet::setAlphaNum
, "_");
442 if (styler
.SafeGetCharAt(j
) == ';') {
443 // Handle forward class declarations ("type TMyClass = class;")
444 // and object method declarations ("TNotifyEvent = procedure(Sender: TObject) of object;")
445 ignoreKeyword
= true;
446 } else if (strcmp(s
, "class") == 0) {
447 // "class" keyword has a few more special cases...
448 if (styler
.SafeGetCharAt(j
) == '(') {
449 // Handle simplified complete class declarations ("type TMyClass = class(TObject);")
450 j
= SkipWhiteSpace(j
, endPos
, styler
, true);
451 if (j
< endPos
&& styler
.SafeGetCharAt(j
) == ')') {
452 j
= SkipWhiteSpace(j
, endPos
, styler
);
453 if (j
< endPos
&& styler
.SafeGetCharAt(j
) == ';') {
454 ignoreKeyword
= true;
457 } else if (setWordStart
.Contains(styler
.SafeGetCharAt(j
))) {
458 char s2
[11]; // Size of the longest possible keyword + one additional character + null
459 GetForwardRangeLowered(j
, setWord
, styler
, s2
, sizeof(s2
));
461 if (strcmp(s2
, "procedure") == 0 ||
462 strcmp(s2
, "function") == 0 ||
463 strcmp(s2
, "of") == 0 ||
464 strcmp(s2
, "var") == 0 ||
465 strcmp(s2
, "property") == 0 ||
466 strcmp(s2
, "operator") == 0) {
467 ignoreKeyword
= true;
472 if (!ignoreKeyword
) {
475 } else if (strcmp(s
, "interface") == 0) {
476 // "interface" keyword requires special handling...
477 bool ignoreKeyword
= true;
478 int j
= lastStart
- 1;
479 char ch
= styler
.SafeGetCharAt(j
);
480 while ((j
>= startPos
) && (IsASpaceOrTab(ch
) || ch
== '\r' || ch
== '\n' ||
481 IsStreamCommentStyle(styler
.StyleAt(j
)))) {
483 ch
= styler
.SafeGetCharAt(j
);
485 if (j
>= startPos
&& styler
.SafeGetCharAt(j
) == '=') {
486 ignoreKeyword
= false;
488 if (!ignoreKeyword
) {
489 unsigned int k
= SkipWhiteSpace(currentPos
, endPos
, styler
);
490 if (k
< endPos
&& styler
.SafeGetCharAt(k
) == ';') {
491 // Handle forward interface declarations ("type IMyInterface = interface;")
492 ignoreKeyword
= true;
495 if (!ignoreKeyword
) {
498 } else if (strcmp(s
, "dispinterface") == 0) {
499 // "dispinterface" keyword requires special handling...
500 bool ignoreKeyword
= false;
501 unsigned int j
= SkipWhiteSpace(currentPos
, endPos
, styler
);
502 if (j
< endPos
&& styler
.SafeGetCharAt(j
) == ';') {
503 // Handle forward dispinterface declarations ("type IMyInterface = dispinterface;")
504 ignoreKeyword
= true;
506 if (!ignoreKeyword
) {
509 } else if (strcmp(s
, "end") == 0) {
510 lineFoldStateCurrent
&= ~stateFoldInRecord
;
512 if (levelCurrent
< SC_FOLDLEVELBASE
) {
513 levelCurrent
= SC_FOLDLEVELBASE
;
518 static void FoldPascalDoc(unsigned int startPos
, int length
, int initStyle
, WordList
*[],
520 bool foldComment
= styler
.GetPropertyInt("fold.comment") != 0;
521 bool foldPreprocessor
= styler
.GetPropertyInt("fold.preprocessor") != 0;
522 bool foldCompact
= styler
.GetPropertyInt("fold.compact", 1) != 0;
523 unsigned int endPos
= startPos
+ length
;
524 int visibleChars
= 0;
525 int lineCurrent
= styler
.GetLine(startPos
);
526 int levelPrev
= styler
.LevelAt(lineCurrent
) & SC_FOLDLEVELNUMBERMASK
;
527 int levelCurrent
= levelPrev
;
528 int lineFoldStateCurrent
= lineCurrent
> 0 ? styler
.GetLineState(lineCurrent
- 1) & stateFoldMaskAll
: 0;
529 char chNext
= styler
[startPos
];
530 int styleNext
= styler
.StyleAt(startPos
);
531 int style
= initStyle
;
534 CharacterSet
setWord(CharacterSet::setAlphaNum
, "_", 0x80, true);
536 for (unsigned int i
= startPos
; i
< endPos
; i
++) {
538 chNext
= styler
.SafeGetCharAt(i
+ 1);
539 int stylePrev
= style
;
541 styleNext
= styler
.StyleAt(i
+ 1);
542 bool atEOL
= (ch
== '\r' && chNext
!= '\n') || (ch
== '\n');
544 if (foldComment
&& IsStreamCommentStyle(style
)) {
545 if (!IsStreamCommentStyle(stylePrev
)) {
547 } else if (!IsStreamCommentStyle(styleNext
) && !atEOL
) {
548 // Comments don't end at end of line and the next character may be unstyled.
552 if (foldComment
&& atEOL
&& IsCommentLine(lineCurrent
, styler
))
554 if (!IsCommentLine(lineCurrent
- 1, styler
)
555 && IsCommentLine(lineCurrent
+ 1, styler
))
557 else if (IsCommentLine(lineCurrent
- 1, styler
)
558 && !IsCommentLine(lineCurrent
+1, styler
))
561 if (foldPreprocessor
) {
562 if (style
== SCE_PAS_PREPROCESSOR
&& ch
== '{' && chNext
== '$') {
563 ClassifyPascalPreprocessorFoldPoint(levelCurrent
, lineFoldStateCurrent
, i
+ 2, styler
);
564 } else if (style
== SCE_PAS_PREPROCESSOR2
&& ch
== '(' && chNext
== '*'
565 && styler
.SafeGetCharAt(i
+ 2) == '$') {
566 ClassifyPascalPreprocessorFoldPoint(levelCurrent
, lineFoldStateCurrent
, i
+ 3, styler
);
570 if (stylePrev
!= SCE_PAS_WORD
&& style
== SCE_PAS_WORD
)
572 // Store last word start point.
575 if (stylePrev
== SCE_PAS_WORD
&& !(lineFoldStateCurrent
& stateFoldInPreprocessor
)) {
576 if(setWord
.Contains(ch
) && !setWord
.Contains(chNext
)) {
577 ClassifyPascalWordFoldPoint(levelCurrent
, lineFoldStateCurrent
, startPos
, endPos
, lastStart
, i
, styler
);
586 if (visibleChars
== 0 && foldCompact
)
587 lev
|= SC_FOLDLEVELWHITEFLAG
;
588 if ((levelCurrent
> levelPrev
) && (visibleChars
> 0))
589 lev
|= SC_FOLDLEVELHEADERFLAG
;
590 if (lev
!= styler
.LevelAt(lineCurrent
)) {
591 styler
.SetLevel(lineCurrent
, lev
);
593 int newLineState
= (styler
.GetLineState(lineCurrent
) & ~stateFoldMaskAll
) | lineFoldStateCurrent
;
594 styler
.SetLineState(lineCurrent
, newLineState
);
596 levelPrev
= levelCurrent
;
601 // If we didn't reach the EOL in previous loop, store line level and whitespace information.
602 // The rest will be filled in later...
604 if (visibleChars
== 0 && foldCompact
)
605 lev
|= SC_FOLDLEVELWHITEFLAG
;
606 styler
.SetLevel(lineCurrent
, lev
);
609 static const char * const pascalWordListDesc
[] = {
614 LexerModule
lmPascal(SCLEX_PASCAL
, ColourisePascalDoc
, "pascal", FoldPascalDoc
, pascalWordListDesc
);