Update Scintilla to version 3.5.7
[TortoiseGit.git] / ext / scintilla / lexers / LexFortran.cxx
blob3b76f77a362ce6124d65b0b8945945a2725ddfae
1 // Scintilla source code edit control
2 /** @file LexFortran.cxx
3 ** Lexer for Fortran.
4 ** Written by Chuan-jian Shen, Last changed Sep. 2003
5 **/
6 // Copyright 1998-2001 by Neil Hodgson <neilh@scintilla.org>
7 // The License.txt file describes the conditions under which this software may be distributed.
8 /***************************************/
9 #include <stdlib.h>
10 #include <string.h>
11 #include <stdio.h>
12 #include <stdarg.h>
13 #include <assert.h>
14 #include <ctype.h>
15 /***************************************/
16 #include "ILexer.h"
17 #include "Scintilla.h"
18 #include "SciLexer.h"
20 #include "WordList.h"
21 #include "LexAccessor.h"
22 #include "Accessor.h"
23 #include "StyleContext.h"
24 #include "CharacterSet.h"
25 #include "LexerModule.h"
26 /***************************************/
28 #ifdef SCI_NAMESPACE
29 using namespace Scintilla;
30 #endif
32 /***********************************************/
33 static inline bool IsAWordChar(const int ch) {
34 return (ch < 0x80) && (isalnum(ch) || ch == '_' || ch == '%');
36 /**********************************************/
37 static inline bool IsAWordStart(const int ch) {
38 return (ch < 0x80) && (isalnum(ch));
40 /***************************************/
41 static inline bool IsABlank(unsigned int ch) {
42 return (ch == ' ') || (ch == 0x09) || (ch == 0x0b) ;
44 /***************************************/
45 static inline bool IsALineEnd(char ch) {
46 return ((ch == '\n') || (ch == '\r')) ;
48 /***************************************/
49 static unsigned int GetContinuedPos(unsigned int pos, Accessor &styler) {
50 while (!IsALineEnd(styler.SafeGetCharAt(pos++))) continue;
51 if (styler.SafeGetCharAt(pos) == '\n') pos++;
52 while (IsABlank(styler.SafeGetCharAt(pos++))) continue;
53 char chCur = styler.SafeGetCharAt(pos);
54 if (chCur == '&') {
55 while (IsABlank(styler.SafeGetCharAt(++pos))) continue;
56 return pos;
57 } else {
58 return pos;
61 /***************************************/
62 static void ColouriseFortranDoc(unsigned int startPos, int length, int initStyle,
63 WordList *keywordlists[], Accessor &styler, bool isFixFormat) {
64 WordList &keywords = *keywordlists[0];
65 WordList &keywords2 = *keywordlists[1];
66 WordList &keywords3 = *keywordlists[2];
67 /***************************************/
68 int posLineStart = 0, numNonBlank = 0, prevState = 0;
69 int endPos = startPos + length;
70 /***************************************/
71 // backtrack to the nearest keyword
72 while ((startPos > 1) && (styler.StyleAt(startPos) != SCE_F_WORD)) {
73 startPos--;
75 startPos = styler.LineStart(styler.GetLine(startPos));
76 initStyle = styler.StyleAt(startPos - 1);
77 StyleContext sc(startPos, endPos-startPos, initStyle, styler);
78 /***************************************/
79 for (; sc.More(); sc.Forward()) {
80 // remember the start position of the line
81 if (sc.atLineStart) {
82 posLineStart = sc.currentPos;
83 numNonBlank = 0;
84 sc.SetState(SCE_F_DEFAULT);
86 if (!IsASpaceOrTab(sc.ch)) numNonBlank ++;
87 /***********************************************/
88 // Handle the fix format generically
89 int toLineStart = sc.currentPos - posLineStart;
90 if (isFixFormat && (toLineStart < 6 || toLineStart >= 72)) {
91 if ((toLineStart == 0 && (tolower(sc.ch) == 'c' || sc.ch == '*')) || sc.ch == '!') {
92 if (sc.MatchIgnoreCase("cdec$") || sc.MatchIgnoreCase("*dec$") || sc.MatchIgnoreCase("!dec$") ||
93 sc.MatchIgnoreCase("cdir$") || sc.MatchIgnoreCase("*dir$") || sc.MatchIgnoreCase("!dir$") ||
94 sc.MatchIgnoreCase("cms$") || sc.MatchIgnoreCase("*ms$") || sc.MatchIgnoreCase("!ms$") ||
95 sc.chNext == '$') {
96 sc.SetState(SCE_F_PREPROCESSOR);
97 } else {
98 sc.SetState(SCE_F_COMMENT);
101 while (!sc.atLineEnd && sc.More()) sc.Forward(); // Until line end
102 } else if (toLineStart >= 72) {
103 sc.SetState(SCE_F_COMMENT);
104 while (!sc.atLineEnd && sc.More()) sc.Forward(); // Until line end
105 } else if (toLineStart < 5) {
106 if (IsADigit(sc.ch))
107 sc.SetState(SCE_F_LABEL);
108 else
109 sc.SetState(SCE_F_DEFAULT);
110 } else if (toLineStart == 5) {
111 //if (!IsASpace(sc.ch) && sc.ch != '0') {
112 if (sc.ch != '\r' && sc.ch != '\n') {
113 sc.SetState(SCE_F_CONTINUATION);
114 if (!IsASpace(sc.ch) && sc.ch != '0')
115 sc.ForwardSetState(prevState);
116 } else
117 sc.SetState(SCE_F_DEFAULT);
119 continue;
121 /***************************************/
122 // Hanndle preprocessor directives
123 if (sc.ch == '#' && numNonBlank == 1)
125 sc.SetState(SCE_F_PREPROCESSOR);
126 while (!sc.atLineEnd && sc.More())
127 sc.Forward(); // Until line end
129 /***************************************/
130 // Handle line continuation generically.
131 if (!isFixFormat && sc.ch == '&' && sc.state != SCE_F_COMMENT) {
132 char chTemp = ' ';
133 int j = 1;
134 while (IsABlank(chTemp) && j<132) {
135 chTemp = static_cast<char>(sc.GetRelative(j));
136 j++;
138 if (chTemp == '!') {
139 sc.SetState(SCE_F_CONTINUATION);
140 if (sc.chNext == '!') sc.ForwardSetState(SCE_F_COMMENT);
141 } else if (chTemp == '\r' || chTemp == '\n') {
142 int currentState = sc.state;
143 sc.SetState(SCE_F_CONTINUATION);
144 sc.ForwardSetState(SCE_F_DEFAULT);
145 while (IsASpace(sc.ch) && sc.More()) sc.Forward();
146 if (sc.ch == '&') {
147 sc.SetState(SCE_F_CONTINUATION);
148 sc.Forward();
150 sc.SetState(currentState);
153 /***************************************/
154 // Determine if the current state should terminate.
155 if (sc.state == SCE_F_OPERATOR) {
156 sc.SetState(SCE_F_DEFAULT);
157 } else if (sc.state == SCE_F_NUMBER) {
158 if (!(IsAWordChar(sc.ch) || sc.ch=='\'' || sc.ch=='\"' || sc.ch=='.')) {
159 sc.SetState(SCE_F_DEFAULT);
161 } else if (sc.state == SCE_F_IDENTIFIER) {
162 if (!IsAWordChar(sc.ch) || (sc.ch == '%')) {
163 char s[100];
164 sc.GetCurrentLowered(s, sizeof(s));
165 if (keywords.InList(s)) {
166 sc.ChangeState(SCE_F_WORD);
167 } else if (keywords2.InList(s)) {
168 sc.ChangeState(SCE_F_WORD2);
169 } else if (keywords3.InList(s)) {
170 sc.ChangeState(SCE_F_WORD3);
172 sc.SetState(SCE_F_DEFAULT);
174 } else if (sc.state == SCE_F_COMMENT || sc.state == SCE_F_PREPROCESSOR) {
175 if (sc.ch == '\r' || sc.ch == '\n') {
176 sc.SetState(SCE_F_DEFAULT);
178 } else if (sc.state == SCE_F_STRING1) {
179 prevState = sc.state;
180 if (sc.ch == '\'') {
181 if (sc.chNext == '\'') {
182 sc.Forward();
183 } else {
184 sc.ForwardSetState(SCE_F_DEFAULT);
185 prevState = SCE_F_DEFAULT;
187 } else if (sc.atLineEnd) {
188 sc.ChangeState(SCE_F_STRINGEOL);
189 sc.ForwardSetState(SCE_F_DEFAULT);
191 } else if (sc.state == SCE_F_STRING2) {
192 prevState = sc.state;
193 if (sc.atLineEnd) {
194 sc.ChangeState(SCE_F_STRINGEOL);
195 sc.ForwardSetState(SCE_F_DEFAULT);
196 } else if (sc.ch == '\"') {
197 if (sc.chNext == '\"') {
198 sc.Forward();
199 } else {
200 sc.ForwardSetState(SCE_F_DEFAULT);
201 prevState = SCE_F_DEFAULT;
204 } else if (sc.state == SCE_F_OPERATOR2) {
205 if (sc.ch == '.') {
206 sc.ForwardSetState(SCE_F_DEFAULT);
208 } else if (sc.state == SCE_F_CONTINUATION) {
209 sc.SetState(SCE_F_DEFAULT);
210 } else if (sc.state == SCE_F_LABEL) {
211 if (!IsADigit(sc.ch)) {
212 sc.SetState(SCE_F_DEFAULT);
213 } else {
214 if (isFixFormat && sc.currentPos-posLineStart > 4)
215 sc.SetState(SCE_F_DEFAULT);
216 else if (numNonBlank > 5)
217 sc.SetState(SCE_F_DEFAULT);
220 /***************************************/
221 // Determine if a new state should be entered.
222 if (sc.state == SCE_F_DEFAULT) {
223 if (sc.ch == '!') {
224 if (sc.MatchIgnoreCase("!dec$") || sc.MatchIgnoreCase("!dir$") ||
225 sc.MatchIgnoreCase("!ms$") || sc.chNext == '$') {
226 sc.SetState(SCE_F_PREPROCESSOR);
227 } else {
228 sc.SetState(SCE_F_COMMENT);
230 } else if ((!isFixFormat) && IsADigit(sc.ch) && numNonBlank == 1) {
231 sc.SetState(SCE_F_LABEL);
232 } else if (IsADigit(sc.ch) || (sc.ch == '.' && IsADigit(sc.chNext))) {
233 sc.SetState(SCE_F_NUMBER);
234 } else if ((tolower(sc.ch) == 'b' || tolower(sc.ch) == 'o' ||
235 tolower(sc.ch) == 'z') && (sc.chNext == '\"' || sc.chNext == '\'')) {
236 sc.SetState(SCE_F_NUMBER);
237 sc.Forward();
238 } else if (sc.ch == '.' && isalpha(sc.chNext)) {
239 sc.SetState(SCE_F_OPERATOR2);
240 } else if (IsAWordStart(sc.ch)) {
241 sc.SetState(SCE_F_IDENTIFIER);
242 } else if (sc.ch == '\"') {
243 sc.SetState(SCE_F_STRING2);
244 } else if (sc.ch == '\'') {
245 sc.SetState(SCE_F_STRING1);
246 } else if (isoperator(static_cast<char>(sc.ch))) {
247 sc.SetState(SCE_F_OPERATOR);
251 sc.Complete();
253 /***************************************/
254 // To determine the folding level depending on keywords
255 static int classifyFoldPointFortran(const char* s, const char* prevWord, const char chNextNonBlank) {
256 int lev = 0;
258 if ((strcmp(prevWord, "module") == 0 && strcmp(s, "subroutine") == 0)
259 || (strcmp(prevWord, "module") == 0 && strcmp(s, "function") == 0)) {
260 lev = 0;
261 } else if (strcmp(s, "associate") == 0 || strcmp(s, "block") == 0
262 || strcmp(s, "blockdata") == 0 || strcmp(s, "select") == 0
263 || strcmp(s, "selecttype") == 0 || strcmp(s, "selectcase") == 0
264 || strcmp(s, "do") == 0 || strcmp(s, "enum") ==0
265 || strcmp(s, "function") == 0 || strcmp(s, "interface") == 0
266 || strcmp(s, "module") == 0 || strcmp(s, "program") == 0
267 || strcmp(s, "subroutine") == 0 || strcmp(s, "then") == 0
268 || (strcmp(s, "type") == 0 && chNextNonBlank != '(')
269 || strcmp(s, "critical") == 0 || strcmp(s, "submodule") == 0){
270 if (strcmp(prevWord, "end") == 0)
271 lev = 0;
272 else
273 lev = 1;
274 } else if ((strcmp(s, "end") == 0 && chNextNonBlank != '=')
275 || strcmp(s, "endassociate") == 0 || strcmp(s, "endblock") == 0
276 || strcmp(s, "endblockdata") == 0 || strcmp(s, "endselect") == 0
277 || strcmp(s, "enddo") == 0 || strcmp(s, "endenum") ==0
278 || strcmp(s, "endif") == 0 || strcmp(s, "endforall") == 0
279 || strcmp(s, "endfunction") == 0 || strcmp(s, "endinterface") == 0
280 || strcmp(s, "endmodule") == 0 || strcmp(s, "endprogram") == 0
281 || strcmp(s, "endsubroutine") == 0 || strcmp(s, "endtype") == 0
282 || strcmp(s, "endwhere") == 0 || strcmp(s, "endcritical") == 0
283 || (strcmp(prevWord, "module") == 0 && strcmp(s, "procedure") == 0) // Take care of the "module procedure" statement
284 || strcmp(s, "endsubmodule") == 0) {
285 lev = -1;
286 } else if (strcmp(prevWord, "end") == 0 && strcmp(s, "if") == 0){ // end if
287 lev = 0;
288 } else if (strcmp(prevWord, "type") == 0 && strcmp(s, "is") == 0){ // type is
289 lev = -1;
290 } else if ((strcmp(prevWord, "end") == 0 && strcmp(s, "procedure") == 0)
291 || strcmp(s, "endprocedure") == 0) {
292 lev = 1; // level back to 0, because no folding support for "module procedure" in submodule
294 return lev;
296 /***************************************/
297 // Folding the code
298 static void FoldFortranDoc(unsigned int startPos, int length, int initStyle,
299 Accessor &styler, bool isFixFormat) {
301 // bool foldComment = styler.GetPropertyInt("fold.comment") != 0;
302 // Do not know how to fold the comment at the moment.
304 bool foldCompact = styler.GetPropertyInt("fold.compact", 1) != 0;
305 unsigned int endPos = startPos + length;
306 int visibleChars = 0;
307 int lineCurrent = styler.GetLine(startPos);
308 int levelCurrent;
309 bool isPrevLine;
310 if (lineCurrent > 0) {
311 lineCurrent--;
312 startPos = styler.LineStart(lineCurrent);
313 levelCurrent = styler.LevelAt(lineCurrent) & SC_FOLDLEVELNUMBERMASK;
314 isPrevLine = true;
315 } else {
316 levelCurrent = styler.LevelAt(lineCurrent) & SC_FOLDLEVELNUMBERMASK;
317 isPrevLine = false;
319 char chNext = styler[startPos];
320 int styleNext = styler.StyleAt(startPos);
321 int style = initStyle;
322 int levelDeltaNext = 0;
323 /***************************************/
324 int lastStart = 0;
325 char prevWord[32] = "";
326 /***************************************/
327 for (unsigned int i = startPos; i < endPos; i++) {
328 char ch = chNext;
329 chNext = styler.SafeGetCharAt(i + 1);
330 char chNextNonBlank = chNext;
331 bool nextEOL = false;
332 if (IsALineEnd(chNextNonBlank)) {
333 nextEOL = true;
335 unsigned int j=i+1;
336 while(IsABlank(chNextNonBlank) && j<endPos) {
337 j ++ ;
338 chNextNonBlank = styler.SafeGetCharAt(j);
339 if (IsALineEnd(chNextNonBlank)) {
340 nextEOL = true;
343 if (!nextEOL && j == endPos) {
344 nextEOL = true;
346 int stylePrev = style;
347 style = styleNext;
348 styleNext = styler.StyleAt(i + 1);
349 bool atEOL = (ch == '\r' && chNext != '\n') || (ch == '\n');
351 if (((isFixFormat && stylePrev == SCE_F_CONTINUATION) || stylePrev == SCE_F_DEFAULT
352 || stylePrev == SCE_F_OPERATOR) && (style == SCE_F_WORD || style == SCE_F_LABEL)) {
353 // Store last word and label start point.
354 lastStart = i;
356 /***************************************/
357 if (style == SCE_F_WORD) {
358 if(iswordchar(ch) && !iswordchar(chNext)) {
359 char s[32];
360 unsigned int k;
361 for(k=0; (k<31 ) && (k<i-lastStart+1 ); k++) {
362 s[k] = static_cast<char>(tolower(styler[lastStart+k]));
364 s[k] = '\0';
365 // Handle the forall and where statement and structure.
366 if (strcmp(s, "forall") == 0 || (strcmp(s, "where") == 0 && strcmp(prevWord, "else") != 0)) {
367 if (strcmp(prevWord, "end") != 0) {
368 j = i + 1;
369 char chBrace = '(', chSeek = ')', ch1 = styler.SafeGetCharAt(j);
370 // Find the position of the first (
371 while (ch1 != chBrace && j<endPos) {
372 j++;
373 ch1 = styler.SafeGetCharAt(j);
375 char styBrace = styler.StyleAt(j);
376 int depth = 1;
377 char chAtPos;
378 char styAtPos;
379 while (j<endPos) {
380 j++;
381 chAtPos = styler.SafeGetCharAt(j);
382 styAtPos = styler.StyleAt(j);
383 if (styAtPos == styBrace) {
384 if (chAtPos == chBrace) depth++;
385 if (chAtPos == chSeek) depth--;
386 if (depth == 0) break;
389 int tmpLineCurrent = lineCurrent;
390 while (j<endPos) {
391 j++;
392 chAtPos = styler.SafeGetCharAt(j);
393 styAtPos = styler.StyleAt(j);
394 if (!IsALineEnd(chAtPos) && (styAtPos == SCE_F_COMMENT || IsABlank(chAtPos))) continue;
395 if (isFixFormat) {
396 if (!IsALineEnd(chAtPos)) {
397 break;
398 } else {
399 if (tmpLineCurrent < styler.GetLine(styler.Length()-1)) {
400 tmpLineCurrent++;
401 j = styler.LineStart(tmpLineCurrent);
402 if (styler.StyleAt(j+5) == SCE_F_CONTINUATION
403 && !IsABlank(styler.SafeGetCharAt(j+5)) && styler.SafeGetCharAt(j+5) != '0') {
404 j += 5;
405 continue;
406 } else {
407 levelDeltaNext++;
408 break;
412 } else {
413 if (chAtPos == '&' && styler.StyleAt(j) == SCE_F_CONTINUATION) {
414 j = GetContinuedPos(j+1, styler);
415 continue;
416 } else if (IsALineEnd(chAtPos)) {
417 levelDeltaNext++;
418 break;
419 } else {
420 break;
425 } else {
426 int wordLevelDelta = classifyFoldPointFortran(s, prevWord, chNextNonBlank);
427 levelDeltaNext += wordLevelDelta;
428 if (((strcmp(s, "else") == 0) && (nextEOL || chNextNonBlank == '!')) ||
429 (strcmp(prevWord, "else") == 0 && strcmp(s, "where") == 0) || strcmp(s, "elsewhere") == 0) {
430 if (!isPrevLine) {
431 levelCurrent--;
433 levelDeltaNext++;
434 } else if ((strcmp(prevWord, "else") == 0 && strcmp(s, "if") == 0) || strcmp(s, "elseif") == 0) {
435 if (!isPrevLine) {
436 levelCurrent--;
438 } else if ((strcmp(prevWord, "select") == 0 && strcmp(s, "case") == 0) || strcmp(s, "selectcase") == 0 ||
439 (strcmp(prevWord, "select") == 0 && strcmp(s, "type") == 0) || strcmp(s, "selecttype") == 0) {
440 levelDeltaNext += 2;
441 } else if ((strcmp(s, "case") == 0 && chNextNonBlank == '(') || (strcmp(prevWord, "case") == 0 && strcmp(s, "default") == 0) ||
442 (strcmp(prevWord, "type") == 0 && strcmp(s, "is") == 0) ||
443 (strcmp(prevWord, "class") == 0 && strcmp(s, "is") == 0) ||
444 (strcmp(prevWord, "class") == 0 && strcmp(s, "default") == 0) ) {
445 if (!isPrevLine) {
446 levelCurrent--;
448 levelDeltaNext++;
449 } else if ((strcmp(prevWord, "end") == 0 && strcmp(s, "select") == 0) || strcmp(s, "endselect") == 0) {
450 levelDeltaNext -= 2;
453 // There are multiple forms of "do" loop. The older form with a label "do 100 i=1,10" would require matching
454 // labels to ensure the folding level does not decrease too far when labels are used for other purposes.
455 // Since this is difficult, do-label constructs are not folded.
456 if (strcmp(s, "do") == 0 && IsADigit(chNextNonBlank)) {
457 // Remove delta for do-label
458 levelDeltaNext -= wordLevelDelta;
461 strcpy(prevWord, s);
464 if (atEOL) {
465 int lev = levelCurrent;
466 if (visibleChars == 0 && foldCompact)
467 lev |= SC_FOLDLEVELWHITEFLAG;
468 if ((levelDeltaNext > 0) && (visibleChars > 0))
469 lev |= SC_FOLDLEVELHEADERFLAG;
470 if (lev != styler.LevelAt(lineCurrent))
471 styler.SetLevel(lineCurrent, lev);
473 lineCurrent++;
474 levelCurrent += levelDeltaNext;
475 levelDeltaNext = 0;
476 visibleChars = 0;
477 strcpy(prevWord, "");
478 isPrevLine = false;
480 /***************************************/
481 if (!isspacechar(ch)) visibleChars++;
483 /***************************************/
485 /***************************************/
486 static const char * const FortranWordLists[] = {
487 "Primary keywords and identifiers",
488 "Intrinsic functions",
489 "Extended and user defined functions",
492 /***************************************/
493 static void ColouriseFortranDocFreeFormat(unsigned int startPos, int length, int initStyle, WordList *keywordlists[],
494 Accessor &styler) {
495 ColouriseFortranDoc(startPos, length, initStyle, keywordlists, styler, false);
497 /***************************************/
498 static void ColouriseFortranDocFixFormat(unsigned int startPos, int length, int initStyle, WordList *keywordlists[],
499 Accessor &styler) {
500 ColouriseFortranDoc(startPos, length, initStyle, keywordlists, styler, true);
502 /***************************************/
503 static void FoldFortranDocFreeFormat(unsigned int startPos, int length, int initStyle,
504 WordList *[], Accessor &styler) {
505 FoldFortranDoc(startPos, length, initStyle,styler, false);
507 /***************************************/
508 static void FoldFortranDocFixFormat(unsigned int startPos, int length, int initStyle,
509 WordList *[], Accessor &styler) {
510 FoldFortranDoc(startPos, length, initStyle,styler, true);
512 /***************************************/
513 LexerModule lmFortran(SCLEX_FORTRAN, ColouriseFortranDocFreeFormat, "fortran", FoldFortranDocFreeFormat, FortranWordLists);
514 LexerModule lmF77(SCLEX_F77, ColouriseFortranDocFixFormat, "f77", FoldFortranDocFixFormat, FortranWordLists);