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 XE4 at this time).
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 delayed deprecated destructor dispid dispinterface
96 div do downto dynamic else end except experimental export exports external far
97 file final finalization finally for forward function goto helper if
98 implementation in inherited initialization inline interface is label library
99 message mod near nil not object of on operator or out overload override packed
100 pascal platform private procedure program property protected public published
101 raise record reference register reintroduce repeat resourcestring safecall
102 sealed set shl shr static stdcall strict string then threadvar to try type unit
103 unsafe until uses var varargs virtual while winapi with xor
105 - Keywords related to the "smart highlithing" feature: add default implements
106 index name nodefault read readonly remove stored write writeonly
108 - Keywords related to Delphi packages (in addition to all above): package
121 #include "Scintilla.h"
122 #include "SciLexer.h"
124 #include "WordList.h"
125 #include "LexAccessor.h"
126 #include "Accessor.h"
127 #include "StyleContext.h"
128 #include "CharacterSet.h"
129 #include "LexerModule.h"
132 using namespace Scintilla
;
135 static void GetRangeLowered(unsigned int start
,
141 while ((i
< end
- start
+ 1) && (i
< len
-1)) {
142 s
[i
] = static_cast<char>(tolower(styler
[start
+ i
]));
148 static void GetForwardRangeLowered(unsigned int start
,
149 CharacterSet
&charSet
,
154 while ((i
< len
-1) && charSet
.Contains(styler
.SafeGetCharAt(start
+ i
))) {
155 s
[i
] = static_cast<char>(tolower(styler
.SafeGetCharAt(start
+ i
)));
164 stateInProperty
= 0x2000,
165 stateInExport
= 0x4000,
166 stateFoldInPreprocessor
= 0x0100,
167 stateFoldInRecord
= 0x0200,
168 stateFoldInPreprocessorLevelMask
= 0x00FF,
169 stateFoldMaskAll
= 0x0FFF
172 static void ClassifyPascalWord(WordList
*keywordlists
[], StyleContext
&sc
, int &curLineState
, bool bSmartHighlighting
) {
173 WordList
& keywords
= *keywordlists
[0];
176 sc
.GetCurrentLowered(s
, sizeof(s
));
177 if (keywords
.InList(s
)) {
178 if (curLineState
& stateInAsm
) {
179 if (strcmp(s
, "end") == 0 && sc
.GetRelative(-4) != '@') {
180 curLineState
&= ~stateInAsm
;
181 sc
.ChangeState(SCE_PAS_WORD
);
183 sc
.ChangeState(SCE_PAS_ASM
);
186 bool ignoreKeyword
= false;
187 if (strcmp(s
, "asm") == 0) {
188 curLineState
|= stateInAsm
;
189 } else if (bSmartHighlighting
) {
190 if (strcmp(s
, "property") == 0) {
191 curLineState
|= stateInProperty
;
192 } else if (strcmp(s
, "exports") == 0) {
193 curLineState
|= stateInExport
;
194 } else if (!(curLineState
& (stateInProperty
| stateInExport
)) && strcmp(s
, "index") == 0) {
195 ignoreKeyword
= true;
196 } else if (!(curLineState
& stateInExport
) && strcmp(s
, "name") == 0) {
197 ignoreKeyword
= true;
198 } else if (!(curLineState
& stateInProperty
) &&
199 (strcmp(s
, "read") == 0 || strcmp(s
, "write") == 0 ||
200 strcmp(s
, "default") == 0 || strcmp(s
, "nodefault") == 0 ||
201 strcmp(s
, "stored") == 0 || strcmp(s
, "implements") == 0 ||
202 strcmp(s
, "readonly") == 0 || strcmp(s
, "writeonly") == 0 ||
203 strcmp(s
, "add") == 0 || strcmp(s
, "remove") == 0)) {
204 ignoreKeyword
= true;
207 if (!ignoreKeyword
) {
208 sc
.ChangeState(SCE_PAS_WORD
);
211 } else if (curLineState
& stateInAsm
) {
212 sc
.ChangeState(SCE_PAS_ASM
);
214 sc
.SetState(SCE_PAS_DEFAULT
);
217 static void ColourisePascalDoc(unsigned int startPos
, int length
, int initStyle
, WordList
*keywordlists
[],
219 bool bSmartHighlighting
= styler
.GetPropertyInt("lexer.pascal.smart.highlighting", 1) != 0;
221 CharacterSet
setWordStart(CharacterSet::setAlpha
, "_", 0x80, true);
222 CharacterSet
setWord(CharacterSet::setAlphaNum
, "_", 0x80, true);
223 CharacterSet
setNumber(CharacterSet::setDigits
, ".-+eE");
224 CharacterSet
setHexNumber(CharacterSet::setDigits
, "abcdefABCDEF");
225 CharacterSet
setOperator(CharacterSet::setNone
, "#$&'()*+,-./:;<=>@[]^{}");
227 int curLine
= styler
.GetLine(startPos
);
228 int curLineState
= curLine
> 0 ? styler
.GetLineState(curLine
- 1) : 0;
230 StyleContext
sc(startPos
, length
, initStyle
, styler
);
232 for (; sc
.More(); sc
.Forward()) {
234 // Update the line state, so it can be seen by next line
235 curLine
= styler
.GetLine(sc
.currentPos
);
236 styler
.SetLineState(curLine
, curLineState
);
239 // Determine if the current state should terminate.
242 if (!setNumber
.Contains(sc
.ch
) || (sc
.ch
== '.' && sc
.chNext
== '.')) {
243 sc
.SetState(SCE_PAS_DEFAULT
);
244 } else if (sc
.ch
== '-' || sc
.ch
== '+') {
245 if (sc
.chPrev
!= 'E' && sc
.chPrev
!= 'e') {
246 sc
.SetState(SCE_PAS_DEFAULT
);
250 case SCE_PAS_IDENTIFIER
:
251 if (!setWord
.Contains(sc
.ch
)) {
252 ClassifyPascalWord(keywordlists
, sc
, curLineState
, bSmartHighlighting
);
255 case SCE_PAS_HEXNUMBER
:
256 if (!setHexNumber
.Contains(sc
.ch
)) {
257 sc
.SetState(SCE_PAS_DEFAULT
);
260 case SCE_PAS_COMMENT
:
261 case SCE_PAS_PREPROCESSOR
:
263 sc
.ForwardSetState(SCE_PAS_DEFAULT
);
266 case SCE_PAS_COMMENT2
:
267 case SCE_PAS_PREPROCESSOR2
:
268 if (sc
.Match('*', ')')) {
270 sc
.ForwardSetState(SCE_PAS_DEFAULT
);
273 case SCE_PAS_COMMENTLINE
:
274 if (sc
.atLineStart
) {
275 sc
.SetState(SCE_PAS_DEFAULT
);
280 sc
.ChangeState(SCE_PAS_STRINGEOL
);
281 } else if (sc
.ch
== '\'' && sc
.chNext
== '\'') {
283 } else if (sc
.ch
== '\'') {
284 sc
.ForwardSetState(SCE_PAS_DEFAULT
);
287 case SCE_PAS_STRINGEOL
:
288 if (sc
.atLineStart
) {
289 sc
.SetState(SCE_PAS_DEFAULT
);
292 case SCE_PAS_CHARACTER
:
293 if (!setHexNumber
.Contains(sc
.ch
) && sc
.ch
!= '$') {
294 sc
.SetState(SCE_PAS_DEFAULT
);
297 case SCE_PAS_OPERATOR
:
298 if (bSmartHighlighting
&& sc
.chPrev
== ';') {
299 curLineState
&= ~(stateInProperty
| stateInExport
);
301 sc
.SetState(SCE_PAS_DEFAULT
);
304 sc
.SetState(SCE_PAS_DEFAULT
);
308 // Determine if a new state should be entered.
309 if (sc
.state
== SCE_PAS_DEFAULT
) {
310 if (IsADigit(sc
.ch
) && !(curLineState
& stateInAsm
)) {
311 sc
.SetState(SCE_PAS_NUMBER
);
312 } else if (setWordStart
.Contains(sc
.ch
)) {
313 sc
.SetState(SCE_PAS_IDENTIFIER
);
314 } else if (sc
.ch
== '$' && !(curLineState
& stateInAsm
)) {
315 sc
.SetState(SCE_PAS_HEXNUMBER
);
316 } else if (sc
.Match('{', '$')) {
317 sc
.SetState(SCE_PAS_PREPROCESSOR
);
318 } else if (sc
.ch
== '{') {
319 sc
.SetState(SCE_PAS_COMMENT
);
320 } else if (sc
.Match("(*$")) {
321 sc
.SetState(SCE_PAS_PREPROCESSOR2
);
322 } else if (sc
.Match('(', '*')) {
323 sc
.SetState(SCE_PAS_COMMENT2
);
324 sc
.Forward(); // Eat the * so it isn't used for the end of the comment
325 } else if (sc
.Match('/', '/')) {
326 sc
.SetState(SCE_PAS_COMMENTLINE
);
327 } else if (sc
.ch
== '\'') {
328 sc
.SetState(SCE_PAS_STRING
);
329 } else if (sc
.ch
== '#') {
330 sc
.SetState(SCE_PAS_CHARACTER
);
331 } else if (setOperator
.Contains(sc
.ch
) && !(curLineState
& stateInAsm
)) {
332 sc
.SetState(SCE_PAS_OPERATOR
);
333 } else if (curLineState
& stateInAsm
) {
334 sc
.SetState(SCE_PAS_ASM
);
339 if (sc
.state
== SCE_PAS_IDENTIFIER
&& setWord
.Contains(sc
.chPrev
)) {
340 ClassifyPascalWord(keywordlists
, sc
, curLineState
, bSmartHighlighting
);
346 static bool IsStreamCommentStyle(int style
) {
347 return style
== SCE_PAS_COMMENT
|| style
== SCE_PAS_COMMENT2
;
350 static bool IsCommentLine(int line
, Accessor
&styler
) {
351 int pos
= styler
.LineStart(line
);
352 int eolPos
= styler
.LineStart(line
+ 1) - 1;
353 for (int i
= pos
; i
< eolPos
; i
++) {
355 char chNext
= styler
.SafeGetCharAt(i
+ 1);
356 int style
= styler
.StyleAt(i
);
357 if (ch
== '/' && chNext
== '/' && style
== SCE_PAS_COMMENTLINE
) {
359 } else if (!IsASpaceOrTab(ch
)) {
366 static unsigned int GetFoldInPreprocessorLevelFlag(int lineFoldStateCurrent
) {
367 return lineFoldStateCurrent
& stateFoldInPreprocessorLevelMask
;
370 static void SetFoldInPreprocessorLevelFlag(int &lineFoldStateCurrent
, unsigned int nestLevel
) {
371 lineFoldStateCurrent
&= ~stateFoldInPreprocessorLevelMask
;
372 lineFoldStateCurrent
|= nestLevel
& stateFoldInPreprocessorLevelMask
;
375 static void ClassifyPascalPreprocessorFoldPoint(int &levelCurrent
, int &lineFoldStateCurrent
,
376 unsigned int startPos
, Accessor
&styler
) {
377 CharacterSet
setWord(CharacterSet::setAlpha
);
379 char s
[11]; // Size of the longest possible keyword + one additional character + null
380 GetForwardRangeLowered(startPos
, setWord
, styler
, s
, sizeof(s
));
382 unsigned int nestLevel
= GetFoldInPreprocessorLevelFlag(lineFoldStateCurrent
);
384 if (strcmp(s
, "if") == 0 ||
385 strcmp(s
, "ifdef") == 0 ||
386 strcmp(s
, "ifndef") == 0 ||
387 strcmp(s
, "ifopt") == 0 ||
388 strcmp(s
, "region") == 0) {
390 SetFoldInPreprocessorLevelFlag(lineFoldStateCurrent
, nestLevel
);
391 lineFoldStateCurrent
|= stateFoldInPreprocessor
;
393 } else if (strcmp(s
, "endif") == 0 ||
394 strcmp(s
, "ifend") == 0 ||
395 strcmp(s
, "endregion") == 0) {
397 SetFoldInPreprocessorLevelFlag(lineFoldStateCurrent
, nestLevel
);
398 if (nestLevel
== 0) {
399 lineFoldStateCurrent
&= ~stateFoldInPreprocessor
;
402 if (levelCurrent
< SC_FOLDLEVELBASE
) {
403 levelCurrent
= SC_FOLDLEVELBASE
;
408 static unsigned int SkipWhiteSpace(unsigned int currentPos
, unsigned int endPos
,
409 Accessor
&styler
, bool includeChars
= false) {
410 CharacterSet
setWord(CharacterSet::setAlphaNum
, "_");
411 unsigned int j
= currentPos
+ 1;
412 char ch
= styler
.SafeGetCharAt(j
);
413 while ((j
< endPos
) && (IsASpaceOrTab(ch
) || ch
== '\r' || ch
== '\n' ||
414 IsStreamCommentStyle(styler
.StyleAt(j
)) || (includeChars
&& setWord
.Contains(ch
)))) {
416 ch
= styler
.SafeGetCharAt(j
);
421 static void ClassifyPascalWordFoldPoint(int &levelCurrent
, int &lineFoldStateCurrent
,
422 int startPos
, unsigned int endPos
,
423 unsigned int lastStart
, unsigned int currentPos
, Accessor
&styler
) {
425 GetRangeLowered(lastStart
, currentPos
, styler
, s
, sizeof(s
));
427 if (strcmp(s
, "record") == 0) {
428 lineFoldStateCurrent
|= stateFoldInRecord
;
430 } else if (strcmp(s
, "begin") == 0 ||
431 strcmp(s
, "asm") == 0 ||
432 strcmp(s
, "try") == 0 ||
433 (strcmp(s
, "case") == 0 && !(lineFoldStateCurrent
& stateFoldInRecord
))) {
435 } else if (strcmp(s
, "class") == 0 || strcmp(s
, "object") == 0) {
436 // "class" & "object" keywords require special handling...
437 bool ignoreKeyword
= false;
438 unsigned int j
= SkipWhiteSpace(currentPos
, endPos
, styler
);
440 CharacterSet
setWordStart(CharacterSet::setAlpha
, "_");
441 CharacterSet
setWord(CharacterSet::setAlphaNum
, "_");
443 if (styler
.SafeGetCharAt(j
) == ';') {
444 // Handle forward class declarations ("type TMyClass = class;")
445 // and object method declarations ("TNotifyEvent = procedure(Sender: TObject) of object;")
446 ignoreKeyword
= true;
447 } else if (strcmp(s
, "class") == 0) {
448 // "class" keyword has a few more special cases...
449 if (styler
.SafeGetCharAt(j
) == '(') {
450 // Handle simplified complete class declarations ("type TMyClass = class(TObject);")
451 j
= SkipWhiteSpace(j
, endPos
, styler
, true);
452 if (j
< endPos
&& styler
.SafeGetCharAt(j
) == ')') {
453 j
= SkipWhiteSpace(j
, endPos
, styler
);
454 if (j
< endPos
&& styler
.SafeGetCharAt(j
) == ';') {
455 ignoreKeyword
= true;
458 } else if (setWordStart
.Contains(styler
.SafeGetCharAt(j
))) {
459 char s2
[11]; // Size of the longest possible keyword + one additional character + null
460 GetForwardRangeLowered(j
, setWord
, styler
, s2
, sizeof(s2
));
462 if (strcmp(s2
, "procedure") == 0 ||
463 strcmp(s2
, "function") == 0 ||
464 strcmp(s2
, "of") == 0 ||
465 strcmp(s2
, "var") == 0 ||
466 strcmp(s2
, "property") == 0 ||
467 strcmp(s2
, "operator") == 0) {
468 ignoreKeyword
= true;
473 if (!ignoreKeyword
) {
476 } else if (strcmp(s
, "interface") == 0) {
477 // "interface" keyword requires special handling...
478 bool ignoreKeyword
= true;
479 int j
= lastStart
- 1;
480 char ch
= styler
.SafeGetCharAt(j
);
481 while ((j
>= startPos
) && (IsASpaceOrTab(ch
) || ch
== '\r' || ch
== '\n' ||
482 IsStreamCommentStyle(styler
.StyleAt(j
)))) {
484 ch
= styler
.SafeGetCharAt(j
);
486 if (j
>= startPos
&& styler
.SafeGetCharAt(j
) == '=') {
487 ignoreKeyword
= false;
489 if (!ignoreKeyword
) {
490 unsigned int k
= SkipWhiteSpace(currentPos
, endPos
, styler
);
491 if (k
< endPos
&& styler
.SafeGetCharAt(k
) == ';') {
492 // Handle forward interface declarations ("type IMyInterface = interface;")
493 ignoreKeyword
= true;
496 if (!ignoreKeyword
) {
499 } else if (strcmp(s
, "dispinterface") == 0) {
500 // "dispinterface" keyword requires special handling...
501 bool ignoreKeyword
= false;
502 unsigned int j
= SkipWhiteSpace(currentPos
, endPos
, styler
);
503 if (j
< endPos
&& styler
.SafeGetCharAt(j
) == ';') {
504 // Handle forward dispinterface declarations ("type IMyInterface = dispinterface;")
505 ignoreKeyword
= true;
507 if (!ignoreKeyword
) {
510 } else if (strcmp(s
, "end") == 0) {
511 lineFoldStateCurrent
&= ~stateFoldInRecord
;
513 if (levelCurrent
< SC_FOLDLEVELBASE
) {
514 levelCurrent
= SC_FOLDLEVELBASE
;
519 static void FoldPascalDoc(unsigned int startPos
, int length
, int initStyle
, WordList
*[],
521 bool foldComment
= styler
.GetPropertyInt("fold.comment") != 0;
522 bool foldPreprocessor
= styler
.GetPropertyInt("fold.preprocessor") != 0;
523 bool foldCompact
= styler
.GetPropertyInt("fold.compact", 1) != 0;
524 unsigned int endPos
= startPos
+ length
;
525 int visibleChars
= 0;
526 int lineCurrent
= styler
.GetLine(startPos
);
527 int levelPrev
= styler
.LevelAt(lineCurrent
) & SC_FOLDLEVELNUMBERMASK
;
528 int levelCurrent
= levelPrev
;
529 int lineFoldStateCurrent
= lineCurrent
> 0 ? styler
.GetLineState(lineCurrent
- 1) & stateFoldMaskAll
: 0;
530 char chNext
= styler
[startPos
];
531 int styleNext
= styler
.StyleAt(startPos
);
532 int style
= initStyle
;
535 CharacterSet
setWord(CharacterSet::setAlphaNum
, "_", 0x80, true);
537 for (unsigned int i
= startPos
; i
< endPos
; i
++) {
539 chNext
= styler
.SafeGetCharAt(i
+ 1);
540 int stylePrev
= style
;
542 styleNext
= styler
.StyleAt(i
+ 1);
543 bool atEOL
= (ch
== '\r' && chNext
!= '\n') || (ch
== '\n');
545 if (foldComment
&& IsStreamCommentStyle(style
)) {
546 if (!IsStreamCommentStyle(stylePrev
)) {
548 } else if (!IsStreamCommentStyle(styleNext
) && !atEOL
) {
549 // Comments don't end at end of line and the next character may be unstyled.
553 if (foldComment
&& atEOL
&& IsCommentLine(lineCurrent
, styler
))
555 if (!IsCommentLine(lineCurrent
- 1, styler
)
556 && IsCommentLine(lineCurrent
+ 1, styler
))
558 else if (IsCommentLine(lineCurrent
- 1, styler
)
559 && !IsCommentLine(lineCurrent
+1, styler
))
562 if (foldPreprocessor
) {
563 if (style
== SCE_PAS_PREPROCESSOR
&& ch
== '{' && chNext
== '$') {
564 ClassifyPascalPreprocessorFoldPoint(levelCurrent
, lineFoldStateCurrent
, i
+ 2, styler
);
565 } else if (style
== SCE_PAS_PREPROCESSOR2
&& ch
== '(' && chNext
== '*'
566 && styler
.SafeGetCharAt(i
+ 2) == '$') {
567 ClassifyPascalPreprocessorFoldPoint(levelCurrent
, lineFoldStateCurrent
, i
+ 3, styler
);
571 if (stylePrev
!= SCE_PAS_WORD
&& style
== SCE_PAS_WORD
)
573 // Store last word start point.
576 if (stylePrev
== SCE_PAS_WORD
&& !(lineFoldStateCurrent
& stateFoldInPreprocessor
)) {
577 if(setWord
.Contains(ch
) && !setWord
.Contains(chNext
)) {
578 ClassifyPascalWordFoldPoint(levelCurrent
, lineFoldStateCurrent
, startPos
, endPos
, lastStart
, i
, styler
);
587 if (visibleChars
== 0 && foldCompact
)
588 lev
|= SC_FOLDLEVELWHITEFLAG
;
589 if ((levelCurrent
> levelPrev
) && (visibleChars
> 0))
590 lev
|= SC_FOLDLEVELHEADERFLAG
;
591 if (lev
!= styler
.LevelAt(lineCurrent
)) {
592 styler
.SetLevel(lineCurrent
, lev
);
594 int newLineState
= (styler
.GetLineState(lineCurrent
) & ~stateFoldMaskAll
) | lineFoldStateCurrent
;
595 styler
.SetLineState(lineCurrent
, newLineState
);
597 levelPrev
= levelCurrent
;
602 // If we didn't reach the EOL in previous loop, store line level and whitespace information.
603 // The rest will be filled in later...
605 if (visibleChars
== 0 && foldCompact
)
606 lev
|= SC_FOLDLEVELWHITEFLAG
;
607 styler
.SetLevel(lineCurrent
, lev
);
610 static const char * const pascalWordListDesc
[] = {
615 LexerModule
lmPascal(SCLEX_PASCAL
, ColourisePascalDoc
, "pascal", FoldPascalDoc
, pascalWordListDesc
);