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 <string>
17#include <string_view>
18/***************************************/
19#include "ILexer.h"
20#include "Scintilla.h"
21#include "SciLexer.h"
22
23#include "WordList.h"
24#include "LexAccessor.h"
25#include "Accessor.h"
26#include "StyleContext.h"
27#include "CharacterSet.h"
28#include "LexerModule.h"
29/***************************************/
30
31using namespace Lexilla;
32
33/***********************************************/
34static inline bool IsAWordChar(const int ch) {
35 return (ch < 0x80) && (isalnum(ch) || ch == '_' || ch == '%');
36}
37/**********************************************/
38static inline bool IsAWordStart(const int ch) {
39 return (ch < 0x80) && (isalnum(ch));
40}
41/***************************************/
42static inline bool IsABlank(unsigned int ch) {
43 return (ch == ' ') || (ch == 0x09) || (ch == 0x0b) ;
44}
45/***************************************/
46static inline bool IsALineEnd(char ch) {
47 return ((ch == '\n') || (ch == '\r')) ;
48}
49/***************************************/
50static Sci_PositionU GetContinuedPos(Sci_PositionU pos, Accessor &styler) {
51 while (!IsALineEnd(styler.SafeGetCharAt(pos++))) continue;
52 if (styler.SafeGetCharAt(pos) == '\n') pos++;
53 while (IsABlank(styler.SafeGetCharAt(pos++))) continue;
54 char chCur = styler.SafeGetCharAt(pos);
55 if (chCur == '&') {
56 while (IsABlank(styler.SafeGetCharAt(++pos))) continue;
57 return pos;
58 } else {
59 return pos;
60 }
61}
62/***************************************/
63static void ColouriseFortranDoc(Sci_PositionU startPos, Sci_Position length, int initStyle,
64 WordList *keywordlists[], Accessor &styler, bool isFixFormat) {
65 WordList &keywords = *keywordlists[0];
66 WordList &keywords2 = *keywordlists[1];
67 WordList &keywords3 = *keywordlists[2];
68 /***************************************/
69 Sci_Position posLineStart = 0;
70 int numNonBlank = 0, prevState = 0;
71 Sci_Position endPos = startPos + length;
72 /***************************************/
73 // backtrack to the nearest keyword
74 while ((startPos > 1) && (styler.StyleAt(startPos) != SCE_F_WORD)) {
75 startPos--;
76 }
77 startPos = styler.LineStart(styler.GetLine(startPos));
78 initStyle = styler.StyleAt(startPos - 1);
79 StyleContext sc(startPos, endPos-startPos, initStyle, styler);
80 /***************************************/
81 for (; sc.More(); sc.Forward()) {
82 // remember the start position of the line
83 if (sc.atLineStart) {
84 posLineStart = sc.currentPos;
85 numNonBlank = 0;
86 sc.SetState(SCE_F_DEFAULT);
87 }
88 if (!IsASpaceOrTab(sc.ch)) numNonBlank ++;
89 /***********************************************/
90 // Handle the fix format generically
91 Sci_Position toLineStart = sc.currentPos - posLineStart;
92 if (isFixFormat && (toLineStart < 6 || toLineStart >= 72)) {
93 if ((toLineStart == 0 && (tolower(sc.ch) == 'c' || sc.ch == '*')) || sc.ch == '!') {
94 if (sc.MatchIgnoreCase("cdec$") || sc.MatchIgnoreCase("*dec$") || sc.MatchIgnoreCase("!dec$") ||
95 sc.MatchIgnoreCase("cdir$") || sc.MatchIgnoreCase("*dir$") || sc.MatchIgnoreCase("!dir$") ||
96 sc.MatchIgnoreCase("cms$") || sc.MatchIgnoreCase("*ms$") || sc.MatchIgnoreCase("!ms$") ||
97 sc.chNext == '$') {
98 sc.SetState(SCE_F_PREPROCESSOR);
99 } else {
100 sc.SetState(SCE_F_COMMENT);
101 }
102
103 while (!sc.atLineEnd && sc.More()) sc.Forward(); // Until line end
104 } else if (toLineStart >= 72) {
105 sc.SetState(SCE_F_COMMENT);
106 while (!sc.atLineEnd && sc.More()) sc.Forward(); // Until line end
107 } else if (toLineStart < 5) {
108 if (IsADigit(sc.ch))
109 sc.SetState(SCE_F_LABEL);
110 else
111 sc.SetState(SCE_F_DEFAULT);
112 } else if (toLineStart == 5) {
113 //if (!IsASpace(sc.ch) && sc.ch != '0') {
114 if (sc.ch != '\r' && sc.ch != '\n') {
115 sc.SetState(SCE_F_CONTINUATION);
116 if (!IsASpace(sc.ch) && sc.ch != '0')
117 sc.ForwardSetState(prevState);
118 } else
119 sc.SetState(SCE_F_DEFAULT);
120 }
121 continue;
122 }
123 /***************************************/
124 // Handle line continuation generically.
125 if (!isFixFormat && sc.ch == '&' && sc.state != SCE_F_COMMENT) {
126 char chTemp = ' ';
127 Sci_Position j = 1;
128 while (IsABlank(chTemp) && j<132) {
129 chTemp = static_cast<char>(sc.GetRelative(j));
130 j++;
131 }
132 if (chTemp == '!') {
133 sc.SetState(SCE_F_CONTINUATION);
134 if (sc.chNext == '!') sc.ForwardSetState(SCE_F_COMMENT);
135 } else if (chTemp == '\r' || chTemp == '\n') {
136 int currentState = sc.state;
137 sc.SetState(SCE_F_CONTINUATION);
138 sc.ForwardSetState(SCE_F_DEFAULT);
139 while (IsASpace(sc.ch) && sc.More()) {
140 sc.Forward();
141 if (sc.atLineStart) numNonBlank = 0;
142 if (!IsASpaceOrTab(sc.ch)) numNonBlank ++;
143 }
144 if (sc.ch == '&') {
145 sc.SetState(SCE_F_CONTINUATION);
146 sc.Forward();
147 }
148 sc.SetState(currentState);
149 }
150 }
151 /***************************************/
152 // Hanndle preprocessor directives
153 if (sc.ch == '#' && numNonBlank == 1)
154 {
155 sc.SetState(SCE_F_PREPROCESSOR);
156 while (!sc.atLineEnd && sc.More())
157 sc.Forward(); // Until line end
158 }
159 /***************************************/
160 // Determine if the current state should terminate.
161 if (sc.state == SCE_F_OPERATOR) {
162 sc.SetState(SCE_F_DEFAULT);
163 } else if (sc.state == SCE_F_NUMBER) {
164 if (!(IsAWordChar(sc.ch) || sc.ch=='\'' || sc.ch=='\"' || sc.ch=='.')) {
165 sc.SetState(SCE_F_DEFAULT);
166 }
167 } else if (sc.state == SCE_F_IDENTIFIER) {
168 if (!IsAWordChar(sc.ch) || (sc.ch == '%')) {
169 char s[100];
170 sc.GetCurrentLowered(s, sizeof(s));
171 if (keywords.InList(s)) {
172 sc.ChangeState(SCE_F_WORD);
173 } else if (keywords2.InList(s)) {
174 sc.ChangeState(SCE_F_WORD2);
175 } else if (keywords3.InList(s)) {
176 sc.ChangeState(SCE_F_WORD3);
177 }
178 sc.SetState(SCE_F_DEFAULT);
179 }
180 } else if (sc.state == SCE_F_COMMENT || sc.state == SCE_F_PREPROCESSOR) {
181 if (sc.ch == '\r' || sc.ch == '\n') {
182 sc.SetState(SCE_F_DEFAULT);
183 }
184 } else if (sc.state == SCE_F_STRING1) {
185 prevState = sc.state;
186 if (sc.ch == '\'') {
187 if (sc.chNext == '\'') {
188 sc.Forward();
189 } else {
190 sc.ForwardSetState(SCE_F_DEFAULT);
191 prevState = SCE_F_DEFAULT;
192 }
193 } else if (sc.atLineEnd) {
194 sc.ChangeState(SCE_F_STRINGEOL);
195 sc.ForwardSetState(SCE_F_DEFAULT);
196 }
197 } else if (sc.state == SCE_F_STRING2) {
198 prevState = sc.state;
199 if (sc.atLineEnd) {
200 sc.ChangeState(SCE_F_STRINGEOL);
201 sc.ForwardSetState(SCE_F_DEFAULT);
202 } else if (sc.ch == '\"') {
203 if (sc.chNext == '\"') {
204 sc.Forward();
205 } else {
206 sc.ForwardSetState(SCE_F_DEFAULT);
207 prevState = SCE_F_DEFAULT;
208 }
209 }
210 } else if (sc.state == SCE_F_OPERATOR2) {
211 if (sc.ch == '.') {
212 sc.ForwardSetState(SCE_F_DEFAULT);
213 }
214 } else if (sc.state == SCE_F_CONTINUATION) {
215 sc.SetState(SCE_F_DEFAULT);
216 } else if (sc.state == SCE_F_LABEL) {
217 if (!IsADigit(sc.ch)) {
218 sc.SetState(SCE_F_DEFAULT);
219 } else {
220 if (isFixFormat && sc.currentPos-posLineStart > 4)
221 sc.SetState(SCE_F_DEFAULT);
222 else if (numNonBlank > 5)
223 sc.SetState(SCE_F_DEFAULT);
224 }
225 }
226 /***************************************/
227 // Determine if a new state should be entered.
228 if (sc.state == SCE_F_DEFAULT) {
229 if (sc.ch == '!') {
230 if (sc.MatchIgnoreCase("!dec$") || sc.MatchIgnoreCase("!dir$") ||
231 sc.MatchIgnoreCase("!ms$") || sc.chNext == '$') {
232 sc.SetState(SCE_F_PREPROCESSOR);
233 } else {
234 sc.SetState(SCE_F_COMMENT);
235 }
236 } else if ((!isFixFormat) && IsADigit(sc.ch) && numNonBlank == 1) {
237 sc.SetState(SCE_F_LABEL);
238 } else if (IsADigit(sc.ch) || (sc.ch == '.' && IsADigit(sc.chNext))) {
239 sc.SetState(SCE_F_NUMBER);
240 } else if ((tolower(sc.ch) == 'b' || tolower(sc.ch) == 'o' ||
241 tolower(sc.ch) == 'z') && (sc.chNext == '\"' || sc.chNext == '\'')) {
242 sc.SetState(SCE_F_NUMBER);
243 sc.Forward();
244 } else if (sc.ch == '.' && isalpha(sc.chNext)) {
245 sc.SetState(SCE_F_OPERATOR2);
246 } else if (IsAWordStart(sc.ch)) {
247 sc.SetState(SCE_F_IDENTIFIER);
248 } else if (sc.ch == '\"') {
249 sc.SetState(SCE_F_STRING2);
250 } else if (sc.ch == '\'') {
251 sc.SetState(SCE_F_STRING1);
252 } else if (isoperator(static_cast<char>(sc.ch))) {
253 sc.SetState(SCE_F_OPERATOR);
254 }
255 }
256 }
257 sc.Complete();
258}
259/***************************************/
260static void CheckLevelCommentLine(const unsigned int nComL,
261 Sci_Position nComColB[], Sci_Position nComColF[], Sci_Position &nComCur,
262 bool comLineB[], bool comLineF[], bool &comLineCur,
263 int &levelDeltaNext) {
264 levelDeltaNext = 0;
265 if (!comLineCur) {
266 return;
267 }
268
269 if (!comLineF[0] || nComColF[0] != nComCur) {
270 unsigned int i=0;
271 for (; i<nComL; i++) {
272 if (!comLineB[i] || nComColB[i] != nComCur) {
273 break;
274 }
275 }
276 if (i == nComL) {
277 levelDeltaNext = -1;
278 }
279 }
280 else if (!comLineB[0] || nComColB[0] != nComCur) {
281 unsigned int i=0;
282 for (; i<nComL; i++) {
283 if (!comLineF[i] || nComColF[i] != nComCur) {
284 break;
285 }
286 }
287 if (i == nComL) {
288 levelDeltaNext = 1;
289 }
290 }
291}
292/***************************************/
293static void GetIfLineComment(Accessor &styler, bool isFixFormat, const Sci_Position line, bool &isComLine, Sci_Position &comCol) {
294 Sci_Position col = 0;
295 isComLine = false;
296 Sci_Position pos = styler.LineStart(line);
297 Sci_Position len = styler.Length();
298 while(pos<len) {
299 char ch = styler.SafeGetCharAt(pos);
300 if (ch == '!' || (isFixFormat && col == 0 && (tolower(ch) == 'c' || ch == '*'))) {
301 isComLine = true;
302 comCol = col;
303 break;
304 }
305 else if (!IsABlank(ch) || IsALineEnd(ch)) {
306 break;
307 }
308 pos++;
309 col++;
310 }
311}
312/***************************************/
313static void StepCommentLine(Accessor &styler, bool isFixFormat, Sci_Position lineCurrent, const unsigned int nComL,
314 Sci_Position nComColB[], Sci_Position nComColF[], Sci_Position &nComCur,
315 bool comLineB[], bool comLineF[], bool &comLineCur) {
316 Sci_Position nLineTotal = styler.GetLine(styler.Length()-1) + 1;
317 if (lineCurrent >= nLineTotal) {
318 return;
319 }
320
321 for (int i=nComL-2; i>=0; i--) {
322 nComColB[i+1] = nComColB[i];
323 comLineB[i+1] = comLineB[i];
324 }
325 nComColB[0] = nComCur;
326 comLineB[0] = comLineCur;
327 nComCur = nComColF[0];
328 comLineCur = comLineF[0];
329 for (unsigned int i=0; i+1<nComL; i++) {
330 nComColF[i] = nComColF[i+1];
331 comLineF[i] = comLineF[i+1];
332 }
333 Sci_Position chL = lineCurrent + nComL;
334 if (chL < nLineTotal) {
335 GetIfLineComment(styler, isFixFormat, chL, comLineF[nComL-1], nComColF[nComL-1]);
336 }
337 else {
338 comLineF[nComL-1] = false;
339 }
340}
341/***************************************/
342static void CheckBackComLines(Accessor &styler, bool isFixFormat, Sci_Position lineCurrent, const unsigned int nComL,
343 Sci_Position nComColB[], Sci_Position nComColF[], Sci_Position nComCur,
344 bool comLineB[], bool comLineF[], bool &comLineCur) {
345 unsigned int nLines = nComL + nComL + 1;
346 bool* comL = new bool[nLines];
347 Sci_Position* nComCol = new Sci_Position[nLines];
348 bool comL0;
349 Sci_Position nComCol0;
350 GetIfLineComment(styler, isFixFormat, lineCurrent-nComL-1, comL0, nComCol0);
351 for (unsigned int i=0; i<nComL; i++) {
352 unsigned copyTo = nComL - i - 1;
353 comL[copyTo] = comLineB[i];
354 nComCol[copyTo] = nComColB[i];
355 }
356 assert(nComL < nLines);
357 comL[nComL] = comLineCur;
358 nComCol[nComL] = nComCur;
359 for (unsigned int i=0; i<nComL; i++) {
360 unsigned copyTo = i + nComL + 1;
361 comL[copyTo] = comLineF[i];
362 nComCol[copyTo] = nComColF[i];
363 }
364
365 Sci_Position lineC = lineCurrent - nComL + 1;
366 Sci_PositionU iStart;
367 if (lineC <= 0) {
368 lineC = 0;
369 iStart = nComL - lineCurrent;
370 }
371 else {
372 iStart = 1;
373 }
374 bool levChanged = false;
375 int lev = styler.LevelAt(lineC) & SC_FOLDLEVELNUMBERMASK;
376
377 for (Sci_PositionU i=iStart; i<=nComL; i++) {
378 if (comL[i] && (!comL[i-1] || nComCol[i] != nComCol[i-1])) {
379 bool increase = true;
380 Sci_PositionU until = i + nComL;
381 for (Sci_PositionU j=i+1; j<=until; j++) {
382 if (!comL[j] || nComCol[j] != nComCol[i]) {
383 increase = false;
384 break;
385 }
386 }
387 lev = styler.LevelAt(lineC) & SC_FOLDLEVELNUMBERMASK;
388 if (increase) {
389 int levH = lev | SC_FOLDLEVELHEADERFLAG;
390 lev += 1;
391 if (levH != styler.LevelAt(lineC)) {
392 styler.SetLevel(lineC, levH);
393 }
394 for (Sci_Position j=lineC+1; j<=lineCurrent; j++) {
395 if (lev != styler.LevelAt(j)) {
396 styler.SetLevel(j, lev);
397 }
398 }
399 break;
400 }
401 else {
402 if (lev != styler.LevelAt(lineC)) {
403 styler.SetLevel(lineC, lev);
404 }
405 }
406 levChanged = true;
407 }
408 else if (levChanged && comL[i]) {
409 if (lev != styler.LevelAt(lineC)) {
410 styler.SetLevel(lineC, lev);
411 }
412 }
413 lineC++;
414 }
415 delete[] comL;
416 delete[] nComCol;
417}
418/***************************************/
419// To determine the folding level depending on keywords
420static int classifyFoldPointFortran(const char* s, const char* prevWord, const char chNextNonBlank) {
421 int lev = 0;
422
423 if ((strcmp(prevWord, "module") == 0 && strcmp(s, "subroutine") == 0)
424 || (strcmp(prevWord, "module") == 0 && strcmp(s, "function") == 0)) {
425 lev = 0;
426 } else if (strcmp(s, "associate") == 0 || strcmp(s, "block") == 0
427 || strcmp(s, "blockdata") == 0 || strcmp(s, "select") == 0
428 || strcmp(s, "selecttype") == 0 || strcmp(s, "selectcase") == 0
429 || strcmp(s, "do") == 0 || strcmp(s, "enum") ==0
430 || strcmp(s, "function") == 0 || strcmp(s, "interface") == 0
431 || strcmp(s, "module") == 0 || strcmp(s, "program") == 0
432 || strcmp(s, "subroutine") == 0 || strcmp(s, "then") == 0
433 || (strcmp(s, "type") == 0 && chNextNonBlank != '(')
434 || strcmp(s, "critical") == 0 || strcmp(s, "submodule") == 0){
435 if (strcmp(prevWord, "end") == 0)
436 lev = 0;
437 else
438 lev = 1;
439 } else if ((strcmp(s, "end") == 0 && chNextNonBlank != '=')
440 || strcmp(s, "endassociate") == 0 || strcmp(s, "endblock") == 0
441 || strcmp(s, "endblockdata") == 0 || strcmp(s, "endselect") == 0
442 || strcmp(s, "enddo") == 0 || strcmp(s, "endenum") ==0
443 || strcmp(s, "endif") == 0 || strcmp(s, "endforall") == 0
444 || strcmp(s, "endfunction") == 0 || strcmp(s, "endinterface") == 0
445 || strcmp(s, "endmodule") == 0 || strcmp(s, "endprogram") == 0
446 || strcmp(s, "endsubroutine") == 0 || strcmp(s, "endtype") == 0
447 || strcmp(s, "endwhere") == 0 || strcmp(s, "endcritical") == 0
448 || (strcmp(prevWord, "module") == 0 && strcmp(s, "procedure") == 0) // Take care of the "module procedure" statement
449 || strcmp(s, "endsubmodule") == 0 || strcmp(s, "endteam") == 0) {
450 lev = -1;
451 } else if (strcmp(prevWord, "end") == 0 && strcmp(s, "if") == 0){ // end if
452 lev = 0;
453 } else if (strcmp(prevWord, "type") == 0 && strcmp(s, "is") == 0){ // type is
454 lev = -1;
455 } else if ((strcmp(prevWord, "end") == 0 && strcmp(s, "procedure") == 0)
456 || strcmp(s, "endprocedure") == 0) {
457 lev = 1; // level back to 0, because no folding support for "module procedure" in submodule
458 } else if (strcmp(prevWord, "change") == 0 && strcmp(s, "team") == 0){ // change team
459 lev = 1;
460 }
461 return lev;
462}
463/***************************************/
464// Folding the code
465static void FoldFortranDoc(Sci_PositionU startPos, Sci_Position length, int initStyle,
466 Accessor &styler, bool isFixFormat) {
467
468 bool foldComment = styler.GetPropertyInt("fold.comment", 1) != 0;
469 bool foldCompact = styler.GetPropertyInt("fold.compact", 1) != 0;
470 Sci_PositionU endPos = startPos + length;
471 int visibleChars = 0;
472 Sci_Position lineCurrent = styler.GetLine(startPos);
473 bool isPrevLine;
474 if (lineCurrent > 0) {
475 lineCurrent--;
476 startPos = styler.LineStart(lineCurrent);
477 isPrevLine = true;
478 } else {
479 isPrevLine = false;
480 }
481 char chNext = styler[startPos];
482 int styleNext = styler.StyleAt(startPos);
483 int style = initStyle;
484 int levelDeltaNext = 0;
485
486 const unsigned int nComL = 3; // defines how many comment lines should be before they are folded
487 Sci_Position nComColB[nComL] = {};
488 Sci_Position nComColF[nComL] = {};
489 Sci_Position nComCur = 0;
490 bool comLineB[nComL] = {};
491 bool comLineF[nComL] = {};
492 bool comLineCur;
493 Sci_Position nLineTotal = styler.GetLine(styler.Length()-1) + 1;
494 if (foldComment) {
495 for (unsigned int i=0; i<nComL; i++) {
496 Sci_Position chL = lineCurrent-(i+1);
497 if (chL < 0) {
498 comLineB[i] = false;
499 break;
500 }
501 GetIfLineComment(styler, isFixFormat, chL, comLineB[i], nComColB[i]);
502 if (!comLineB[i]) {
503 for (unsigned int j=i+1; j<nComL; j++) {
504 comLineB[j] = false;
505 }
506 break;
507 }
508 }
509 for (unsigned int i=0; i<nComL; i++) {
510 Sci_Position chL = lineCurrent+i+1;
511 if (chL >= nLineTotal) {
512 comLineF[i] = false;
513 break;
514 }
515 GetIfLineComment(styler, isFixFormat, chL, comLineF[i], nComColF[i]);
516 }
517 GetIfLineComment(styler, isFixFormat, lineCurrent, comLineCur, nComCur);
518 CheckBackComLines(styler, isFixFormat, lineCurrent, nComL, nComColB, nComColF, nComCur,
519 comLineB, comLineF, comLineCur);
520 }
521 int levelCurrent = styler.LevelAt(lineCurrent) & SC_FOLDLEVELNUMBERMASK;
522
523 /***************************************/
524 Sci_Position lastStart = 0;
525 char prevWord[32] = "";
526 /***************************************/
527 for (Sci_PositionU i = startPos; i < endPos; i++) {
528 char ch = chNext;
529 chNext = styler.SafeGetCharAt(i + 1);
530 char chNextNonBlank = chNext;
531 bool nextEOL = false;
532 if (IsALineEnd(chNextNonBlank)) {
533 nextEOL = true;
534 }
535 Sci_PositionU j=i+1;
536 while(IsABlank(chNextNonBlank) && j<endPos) {
537 j ++ ;
538 chNextNonBlank = styler.SafeGetCharAt(j);
539 if (IsALineEnd(chNextNonBlank)) {
540 nextEOL = true;
541 }
542 }
543 if (!nextEOL && j == endPos) {
544 nextEOL = true;
545 }
546 int stylePrev = style;
547 style = styleNext;
548 styleNext = styler.StyleAt(i + 1);
549 bool atEOL = (ch == '\r' && chNext != '\n') || (ch == '\n');
550 //
551 if (((isFixFormat && stylePrev == SCE_F_CONTINUATION) || stylePrev == SCE_F_DEFAULT
552 || stylePrev == SCE_F_OPERATOR) && (style == SCE_F_WORD || style == SCE_F_LABEL)) {
553 // Store last word and label start point.
554 lastStart = i;
555 }
556 /***************************************/
557 if (style == SCE_F_WORD) {
558 if(iswordchar(ch) && !iswordchar(chNext)) {
559 char s[32];
560 Sci_PositionU k;
561 for(k=0; (k<31 ) && (k<i-lastStart+1 ); k++) {
562 s[k] = static_cast<char>(tolower(styler[lastStart+k]));
563 }
564 s[k] = '\0';
565 // Handle the forall and where statement and structure.
566 if (strcmp(s, "forall") == 0 || (strcmp(s, "where") == 0 && strcmp(prevWord, "else") != 0)) {
567 if (strcmp(prevWord, "end") != 0) {
568 j = i + 1;
569 char chBrace = '(', chSeek = ')', ch1 = styler.SafeGetCharAt(j);
570 // Find the position of the first (
571 while (ch1 != chBrace && j<endPos) {
572 j++;
573 ch1 = styler.SafeGetCharAt(j);
574 }
575 char styBrace = styler.StyleAt(j);
576 int depth = 1;
577 char chAtPos;
578 char styAtPos;
579 while (j<endPos) {
580 j++;
581 chAtPos = styler.SafeGetCharAt(j);
582 styAtPos = styler.StyleAt(j);
583 if (styAtPos == styBrace) {
584 if (chAtPos == chBrace) depth++;
585 if (chAtPos == chSeek) depth--;
586 if (depth == 0) break;
587 }
588 }
589 Sci_Position tmpLineCurrent = lineCurrent;
590 while (j<endPos) {
591 j++;
592 chAtPos = styler.SafeGetCharAt(j);
593 styAtPos = styler.StyleAt(j);
594 if (!IsALineEnd(chAtPos) && (styAtPos == SCE_F_COMMENT || IsABlank(chAtPos))) continue;
595 if (isFixFormat) {
596 if (!IsALineEnd(chAtPos)) {
597 break;
598 } else {
599 if (tmpLineCurrent < styler.GetLine(styler.Length()-1)) {
600 tmpLineCurrent++;
601 j = styler.LineStart(tmpLineCurrent);
602 if (styler.StyleAt(j+5) == SCE_F_CONTINUATION
603 && !IsABlank(styler.SafeGetCharAt(j+5)) && styler.SafeGetCharAt(j+5) != '0') {
604 j += 5;
605 continue;
606 } else {
607 levelDeltaNext++;
608 break;
609 }
610 }
611 }
612 } else {
613 if (chAtPos == '&' && styler.StyleAt(j) == SCE_F_CONTINUATION) {
614 j = GetContinuedPos(j+1, styler);
615 continue;
616 } else if (IsALineEnd(chAtPos)) {
617 levelDeltaNext++;
618 break;
619 } else {
620 break;
621 }
622 }
623 }
624 }
625 } else {
626 int wordLevelDelta = classifyFoldPointFortran(s, prevWord, chNextNonBlank);
627 levelDeltaNext += wordLevelDelta;
628 if (((strcmp(s, "else") == 0) && (nextEOL || chNextNonBlank == '!')) ||
629 (strcmp(prevWord, "else") == 0 && strcmp(s, "where") == 0) || strcmp(s, "elsewhere") == 0) {
630 if (!isPrevLine) {
631 levelCurrent--;
632 }
633 levelDeltaNext++;
634 } else if ((strcmp(prevWord, "else") == 0 && strcmp(s, "if") == 0) || strcmp(s, "elseif") == 0) {
635 if (!isPrevLine) {
636 levelCurrent--;
637 }
638 } else if ((strcmp(prevWord, "select") == 0 && strcmp(s, "case") == 0) || strcmp(s, "selectcase") == 0 ||
639 (strcmp(prevWord, "select") == 0 && strcmp(s, "type") == 0) || strcmp(s, "selecttype") == 0) {
640 levelDeltaNext += 2;
641 } else if ((strcmp(s, "case") == 0 && chNextNonBlank == '(') || (strcmp(prevWord, "case") == 0 && strcmp(s, "default") == 0) ||
642 (strcmp(prevWord, "type") == 0 && strcmp(s, "is") == 0) ||
643 (strcmp(prevWord, "class") == 0 && strcmp(s, "is") == 0) ||
644 (strcmp(prevWord, "class") == 0 && strcmp(s, "default") == 0) ) {
645 if (!isPrevLine) {
646 levelCurrent--;
647 }
648 levelDeltaNext++;
649 } else if ((strcmp(prevWord, "end") == 0 && strcmp(s, "select") == 0) || strcmp(s, "endselect") == 0) {
650 levelDeltaNext -= 2;
651 }
652
653 // There are multiple forms of "do" loop. The older form with a label "do 100 i=1,10" would require matching
654 // labels to ensure the folding level does not decrease too far when labels are used for other purposes.
655 // Since this is difficult, do-label constructs are not folded.
656 if (strcmp(s, "do") == 0 && IsADigit(chNextNonBlank)) {
657 // Remove delta for do-label
658 levelDeltaNext -= wordLevelDelta;
659 }
660 }
661 strcpy(prevWord, s);
662 }
663 }
664 if (atEOL) {
665 if (foldComment) {
666 int ldNext;
667 CheckLevelCommentLine(nComL, nComColB, nComColF, nComCur, comLineB, comLineF, comLineCur, ldNext);
668 levelDeltaNext += ldNext;
669 }
670 int lev = levelCurrent;
671 if (visibleChars == 0 && foldCompact)
672 lev |= SC_FOLDLEVELWHITEFLAG;
673 if ((levelDeltaNext > 0) && (visibleChars > 0))
674 lev |= SC_FOLDLEVELHEADERFLAG;
675 if (lev != styler.LevelAt(lineCurrent))
676 styler.SetLevel(lineCurrent, lev);
677
678 lineCurrent++;
679 levelCurrent += levelDeltaNext;
680 levelDeltaNext = 0;
681 visibleChars = 0;
682 strcpy(prevWord, "");
683 isPrevLine = false;
684
685 if (foldComment) {
686 StepCommentLine(styler, isFixFormat, lineCurrent, nComL, nComColB, nComColF, nComCur,
687 comLineB, comLineF, comLineCur);
688 }
689 }
690 /***************************************/
691 if (!isspacechar(ch)) visibleChars++;
692 }
693 /***************************************/
694}
695/***************************************/
696static const char * const FortranWordLists[] = {
697 "Primary keywords and identifiers",
698 "Intrinsic functions",
699 "Extended and user defined functions",
700 0,
701};
702/***************************************/
703static void ColouriseFortranDocFreeFormat(Sci_PositionU startPos, Sci_Position length, int initStyle, WordList *keywordlists[],
704 Accessor &styler) {
705 ColouriseFortranDoc(startPos, length, initStyle, keywordlists, styler, false);
706}
707/***************************************/
708static void ColouriseFortranDocFixFormat(Sci_PositionU startPos, Sci_Position length, int initStyle, WordList *keywordlists[],
709 Accessor &styler) {
710 ColouriseFortranDoc(startPos, length, initStyle, keywordlists, styler, true);
711}
712/***************************************/
713static void FoldFortranDocFreeFormat(Sci_PositionU startPos, Sci_Position length, int initStyle,
714 WordList *[], Accessor &styler) {
715 FoldFortranDoc(startPos, length, initStyle,styler, false);
716}
717/***************************************/
718static void FoldFortranDocFixFormat(Sci_PositionU startPos, Sci_Position length, int initStyle,
719 WordList *[], Accessor &styler) {
720 FoldFortranDoc(startPos, length, initStyle,styler, true);
721}
722/***************************************/
723LexerModule lmFortran(SCLEX_FORTRAN, ColouriseFortranDocFreeFormat, "fortran", FoldFortranDocFreeFormat, FortranWordLists);
724LexerModule lmF77(SCLEX_F77, ColouriseFortranDocFixFormat, "f77", FoldFortranDocFixFormat, FortranWordLists);
725