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