?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Fix "Contributing to this document" for new HTML/PDF generation process
[geany-mirror.git] / scintilla / lexers / LexFortran.cxx
blob5deaf11737da715d8273697dec5b46d5a0908f51
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 /***********************************************/
33 static inline bool IsAWordChar(const int ch) {
34 return (ch < 0x80) && (isalnum(ch) || ch == '_' || ch == '%');
35 }
36 /**********************************************/
37 static inline bool IsAWordStart(const int ch) {
38 return (ch < 0x80) && (isalnum(ch));
39 }
40 /***************************************/
41 static inline bool IsABlank(unsigned int ch) {
42 return (ch == ' ') || (ch == 0x09) || (ch == 0x0b) ;
43 }
44 /***************************************/
45 static inline bool IsALineEnd(char ch) {
46 return ((ch == '\n') || (ch == '\r')) ;
47 }
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;
59 }
60 }
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--;
74 }
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);
85 }
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);
99 }
100
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);
118 }
119 continue;
120 }
121 /***************************************/
122 // Hanndle preprocessor directives
123 if (sc.ch == '#' && numNonBlank == 1)
124 {
125 sc.SetState(SCE_F_PREPROCESSOR);
126 while (!sc.atLineEnd && sc.More())
127 sc.Forward(); // Until line end
128 }
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++;
137 }
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();
149 }
150 sc.SetState(currentState);
151 }
152 }
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);
160 }
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);
171 }
172 sc.SetState(SCE_F_DEFAULT);
173 }
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);
177 }
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;
186 }
187 } else if (sc.atLineEnd) {
188 sc.ChangeState(SCE_F_STRINGEOL);
189 sc.ForwardSetState(SCE_F_DEFAULT);
190 }
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;
202 }
203 }
204 } else if (sc.state == SCE_F_OPERATOR2) {
205 if (sc.ch == '.') {
206 sc.ForwardSetState(SCE_F_DEFAULT);
207 }
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);
218 }
219 }
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);
229 }
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);
248 }
249 }
250 }
251 sc.Complete();
252 }
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;
257
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, "do") == 0 || strcmp(s, "enum") ==0
264 || strcmp(s, "function") == 0 || strcmp(s, "interface") == 0
265 || strcmp(s, "module") == 0 || strcmp(s, "program") == 0
266 || strcmp(s, "subroutine") == 0 || strcmp(s, "then") == 0
267 || (strcmp(s, "type") == 0 && chNextNonBlank != '(')
268 || strcmp(s, "critical") == 0 || strcmp(s, "submodule") == 0){
269 if (strcmp(prevWord, "end") == 0)
270 lev = 0;
271 else
272 lev = 1;
273 } else if ((strcmp(s, "end") == 0 && chNextNonBlank != '=')
274 || strcmp(s, "endassociate") == 0 || strcmp(s, "endblock") == 0
275 || strcmp(s, "endblockdata") == 0 || strcmp(s, "endselect") == 0
276 || strcmp(s, "enddo") == 0 || strcmp(s, "endenum") ==0
277 || strcmp(s, "endif") == 0 || strcmp(s, "endforall") == 0
278 || strcmp(s, "endfunction") == 0 || strcmp(s, "endinterface") == 0
279 || strcmp(s, "endmodule") == 0 || strcmp(s, "endprogram") == 0
280 || strcmp(s, "endsubroutine") == 0 || strcmp(s, "endtype") == 0
281 || strcmp(s, "endwhere") == 0 || strcmp(s, "endcritical") == 0
282 || (strcmp(prevWord, "module") == 0 && strcmp(s, "procedure") == 0) // Take care of the "module procedure" statement
283 || strcmp(s, "endsubmodule") == 0) {
284 lev = -1;
285 } else if (strcmp(prevWord, "end") == 0 && strcmp(s, "if") == 0){ // end if
286 lev = 0;
287 } else if (strcmp(prevWord, "type") == 0 && strcmp(s, "is") == 0){ // type is
288 lev = -1;
289 } else if ((strcmp(prevWord, "end") == 0 && strcmp(s, "procedure") == 0)
290 || strcmp(s, "endprocedure") == 0) {
291 lev = 1; // level back to 0, because no folding support for "module procedure" in submodule
292 }
293 return lev;
294 }
295 /***************************************/
296 // Folding the code
297 static void FoldFortranDoc(unsigned int startPos, int length, int initStyle,
298 Accessor &styler, bool isFixFormat) {
299 //
300 // bool foldComment = styler.GetPropertyInt("fold.comment") != 0;
301 // Do not know how to fold the comment at the moment.
302 //
303 bool foldCompact = styler.GetPropertyInt("fold.compact", 1) != 0;
304 unsigned int endPos = startPos + length;
305 int visibleChars = 0;
306 int lineCurrent = styler.GetLine(startPos);
307 int levelCurrent;
308 bool isPrevLine;
309 if (lineCurrent > 0) {
310 lineCurrent--;
311 startPos = styler.LineStart(lineCurrent);
312 levelCurrent = styler.LevelAt(lineCurrent) & SC_FOLDLEVELNUMBERMASK;
313 isPrevLine = true;
314 } else {
315 levelCurrent = styler.LevelAt(lineCurrent) & SC_FOLDLEVELNUMBERMASK;
316 isPrevLine = false;
317 }
318 char chNext = styler[startPos];
319 int styleNext = styler.StyleAt(startPos);
320 int style = initStyle;
321 int levelDeltaNext = 0;
322 /***************************************/
323 int lastStart = 0;
324 char prevWord[32] = "";
325 /***************************************/
326 for (unsigned int i = startPos; i < endPos; i++) {
327 char ch = chNext;
328 chNext = styler.SafeGetCharAt(i + 1);
329 char chNextNonBlank = chNext;
330 bool nextEOL = false;
331 if (IsALineEnd(chNextNonBlank)) {
332 nextEOL = true;
333 }
334 unsigned int j=i+1;
335 while(IsABlank(chNextNonBlank) && j<endPos) {
336 j ++ ;
337 chNextNonBlank = styler.SafeGetCharAt(j);
338 if (IsALineEnd(chNextNonBlank)) {
339 nextEOL = true;
340 }
341 }
342 if (!nextEOL && j == endPos) {
343 nextEOL = true;
344 }
345 int stylePrev = style;
346 style = styleNext;
347 styleNext = styler.StyleAt(i + 1);
348 bool atEOL = (ch == '\r' && chNext != '\n') || (ch == '\n');
349 //
350 if (((isFixFormat && stylePrev == SCE_F_CONTINUATION) || stylePrev == SCE_F_DEFAULT
351 || stylePrev == SCE_F_OPERATOR) && (style == SCE_F_WORD || style == SCE_F_LABEL)) {
352 // Store last word and label start point.
353 lastStart = i;
354 }
355 /***************************************/
356 if (style == SCE_F_WORD) {
357 if(iswordchar(ch) && !iswordchar(chNext)) {
358 char s[32];
359 unsigned int k;
360 for(k=0; (k<31 ) && (k<i-lastStart+1 ); k++) {
361 s[k] = static_cast<char>(tolower(styler[lastStart+k]));
362 }
363 s[k] = '\0';
364 // Handle the forall and where statement and structure.
365 if (strcmp(s, "forall") == 0 || (strcmp(s, "where") == 0 && strcmp(prevWord, "else") != 0)) {
366 if (strcmp(prevWord, "end") != 0) {
367 j = i + 1;
368 char chBrace = '(', chSeek = ')', ch1 = styler.SafeGetCharAt(j);
369 // Find the position of the first (
370 while (ch1 != chBrace && j<endPos) {
371 j++;
372 ch1 = styler.SafeGetCharAt(j);
373 }
374 char styBrace = styler.StyleAt(j);
375 int depth = 1;
376 char chAtPos;
377 char styAtPos;
378 while (j<endPos) {
379 j++;
380 chAtPos = styler.SafeGetCharAt(j);
381 styAtPos = styler.StyleAt(j);
382 if (styAtPos == styBrace) {
383 if (chAtPos == chBrace) depth++;
384 if (chAtPos == chSeek) depth--;
385 if (depth == 0) break;
386 }
387 }
388 int tmpLineCurrent = lineCurrent;
389 while (j<endPos) {
390 j++;
391 chAtPos = styler.SafeGetCharAt(j);
392 styAtPos = styler.StyleAt(j);
393 if (!IsALineEnd(chAtPos) && (styAtPos == SCE_F_COMMENT || IsABlank(chAtPos))) continue;
394 if (isFixFormat) {
395 if (!IsALineEnd(chAtPos)) {
396 break;
397 } else {
398 if (tmpLineCurrent < styler.GetLine(styler.Length()-1)) {
399 tmpLineCurrent++;
400 j = styler.LineStart(tmpLineCurrent);
401 if (styler.StyleAt(j+5) == SCE_F_CONTINUATION
402 && !IsABlank(styler.SafeGetCharAt(j+5)) && styler.SafeGetCharAt(j+5) != '0') {
403 j += 5;
404 continue;
405 } else {
406 levelDeltaNext++;
407 break;
408 }
409 }
410 }
411 } else {
412 if (chAtPos == '&' && styler.StyleAt(j) == SCE_F_CONTINUATION) {
413 j = GetContinuedPos(j+1, styler);
414 continue;
415 } else if (IsALineEnd(chAtPos)) {
416 levelDeltaNext++;
417 break;
418 } else {
419 break;
420 }
421 }
422 }
423 }
424 } else {
425 int wordLevelDelta = classifyFoldPointFortran(s, prevWord, chNextNonBlank);
426 levelDeltaNext += wordLevelDelta;
427 if (((strcmp(s, "else") == 0) && (nextEOL || chNextNonBlank == '!')) ||
428 (strcmp(prevWord, "else") == 0 && strcmp(s, "where") == 0) || strcmp(s, "elsewhere") == 0) {
429 if (!isPrevLine) {
430 levelCurrent--;
431 }
432 levelDeltaNext++;
433 } else if ((strcmp(prevWord, "else") == 0 && strcmp(s, "if") == 0) || strcmp(s, "elseif") == 0) {
434 if (!isPrevLine) {
435 levelCurrent--;
436 }
437 } else if ((strcmp(prevWord, "select") == 0 && strcmp(s, "case") == 0) || strcmp(s, "selectcase") == 0 ||
438 (strcmp(prevWord, "select") == 0 && strcmp(s, "type") == 0) || strcmp(s, "selecttype") == 0) {
439 levelDeltaNext += 2;
440 } else if ((strcmp(s, "case") == 0 && chNextNonBlank == '(') || (strcmp(prevWord, "case") == 0 && strcmp(s, "default") == 0) ||
441 (strcmp(prevWord, "type") == 0 && strcmp(s, "is") == 0) ||
442 (strcmp(prevWord, "class") == 0 && strcmp(s, "is") == 0) ||
443 (strcmp(prevWord, "class") == 0 && strcmp(s, "default") == 0) ) {
444 if (!isPrevLine) {
445 levelCurrent--;
446 }
447 levelDeltaNext++;
448 } else if ((strcmp(prevWord, "end") == 0 && strcmp(s, "select") == 0) || strcmp(s, "endselect") == 0) {
449 levelDeltaNext -= 2;
450 }
451
452 // There are multiple forms of "do" loop. The older form with a label "do 100 i=1,10" would require matching
453 // labels to ensure the folding level does not decrease too far when labels are used for other purposes.
454 // Since this is difficult, do-label constructs are not folded.
455 if (strcmp(s, "do") == 0 && IsADigit(chNextNonBlank)) {
456 // Remove delta for do-label
457 levelDeltaNext -= wordLevelDelta;
458 }
459 }
460 strcpy(prevWord, s);
461 }
462 }
463 if (atEOL) {
464 int lev = levelCurrent;
465 if (visibleChars == 0 && foldCompact)
466 lev |= SC_FOLDLEVELWHITEFLAG;
467 if ((levelDeltaNext > 0) && (visibleChars > 0))
468 lev |= SC_FOLDLEVELHEADERFLAG;
469 if (lev != styler.LevelAt(lineCurrent))
470 styler.SetLevel(lineCurrent, lev);
471
472 lineCurrent++;
473 levelCurrent += levelDeltaNext;
474 levelDeltaNext = 0;
475 visibleChars = 0;
476 strcpy(prevWord, "");
477 isPrevLine = false;
478 }
479 /***************************************/
480 if (!isspacechar(ch)) visibleChars++;
481 }
482 /***************************************/
483 }
484 /***************************************/
485 static const char * const FortranWordLists[] = {
486 "Primary keywords and identifiers",
487 "Intrinsic functions",
488 "Extended and user defined functions",
489 0,
490 };
491 /***************************************/
492 static void ColouriseFortranDocFreeFormat(unsigned int startPos, int length, int initStyle, WordList *keywordlists[],
493 Accessor &styler) {
494 ColouriseFortranDoc(startPos, length, initStyle, keywordlists, styler, false);
495 }
496 /***************************************/
497 static void ColouriseFortranDocFixFormat(unsigned int startPos, int length, int initStyle, WordList *keywordlists[],
498 Accessor &styler) {
499 ColouriseFortranDoc(startPos, length, initStyle, keywordlists, styler, true);
500 }
501 /***************************************/
502 static void FoldFortranDocFreeFormat(unsigned int startPos, int length, int initStyle,
503 WordList *[], Accessor &styler) {
504 FoldFortranDoc(startPos, length, initStyle,styler, false);
505 }
506 /***************************************/
507 static void FoldFortranDocFixFormat(unsigned int startPos, int length, int initStyle,
508 WordList *[], Accessor &styler) {
509 FoldFortranDoc(startPos, length, initStyle,styler, true);
510 }
511 /***************************************/
512 LexerModule lmFortran(SCLEX_FORTRAN, ColouriseFortranDocFreeFormat, "fortran", FoldFortranDocFreeFormat, FortranWordLists);
513 LexerModule lmF77(SCLEX_F77, ColouriseFortranDocFixFormat, "f77", FoldFortranDocFixFormat, FortranWordLists);
A fast and lightweight IDE