ext/scintilla/src/LexFortran.cxx

   1 // Scintilla source code edit control
   2 /** @file LexFortran.cxx
   3  ** Lexer for Fortran.
   4  ** Writen 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 <ctype.h>
  12 #include <stdio.h>
  13 #include <stdarg.h>
  14 /***************************************/
  15 #include "Platform.h"
  16 #include "PropSet.h"
  17 #include "Accessor.h"
  18 #include "StyleContext.h"
  19 #include "KeyWords.h"
  20 #include "Scintilla.h"
  21 #include "SciLexer.h"
  22
  23 #ifdef SCI_NAMESPACE
  24 using namespace Scintilla;
  25 #endif
  26
  27 /***********************************************/
  28 static inline bool IsAWordChar(const int ch) {
  29         return (ch < 0x80) && (isalnum(ch) || ch == '_' || ch == '%');
  30 }
  31 /**********************************************/
  32 static inline bool IsAWordStart(const int ch) {
  33         return (ch < 0x80) && (isalnum(ch));
  34 }
  35 /***************************************/
  36 inline bool IsABlank(unsigned int ch) {
  37     return (ch == ' ') || (ch == 0x09) || (ch == 0x0b) ;
  38 }
  39 /***************************************/
  40 inline bool IsALineEnd(char ch) {
  41     return ((ch == '\n') || (ch == '\r')) ;
  42 }
  43 /***************************************/
  44 unsigned int GetContinuedPos(unsigned int pos, Accessor &styler) {
  45         while (!IsALineEnd(styler.SafeGetCharAt(pos++))) continue;
  46         if (styler.SafeGetCharAt(pos) == '\n') pos++;
  47         while (IsABlank(styler.SafeGetCharAt(pos++))) continue;
  48         char chCur = styler.SafeGetCharAt(pos);
  49         if (chCur == '&') {
  50                 while (IsABlank(styler.SafeGetCharAt(++pos))) continue;
  51                 return pos;
  52         } else {
  53                 return pos;
  54         }
  55 }
  56 /***************************************/
  57 static void ColouriseFortranDoc(unsigned int startPos, int length, int initStyle,
  58                         WordList *keywordlists[], Accessor &styler, bool isFixFormat) {
  59         WordList &keywords = *keywordlists[0];
  60         WordList &keywords2 = *keywordlists[1];
  61         WordList &keywords3 = *keywordlists[2];
  62         /***************************************/
  63         int posLineStart = 0, numNonBlank = 0, prevState = 0;
  64         int endPos = startPos + length;
  65         /***************************************/
  66         // backtrack to the nearest keyword
  67         while ((startPos > 1) && (styler.StyleAt(startPos) != SCE_F_WORD)) {
  68                 startPos--;
  69         }
  70         startPos = styler.LineStart(styler.GetLine(startPos));
  71         initStyle = styler.StyleAt(startPos - 1);
  72         StyleContext sc(startPos, endPos-startPos, initStyle, styler);
  73         /***************************************/
  74         for (; sc.More(); sc.Forward()) {
  75                 // remember the start position of the line
  76                 if (sc.atLineStart) {
  77                         posLineStart = sc.currentPos;
  78                         numNonBlank = 0;
  79                         sc.SetState(SCE_F_DEFAULT);
  80                 }
  81                 if (!IsASpaceOrTab(sc.ch)) numNonBlank ++;
  82                 /***********************************************/
  83                 // Handle the fix format generically
  84                 int toLineStart = sc.currentPos - posLineStart;
  85                 if (isFixFormat && (toLineStart < 6 || toLineStart > 72)) {
  86                         if (toLineStart == 0 && (tolower(sc.ch) == 'c' || sc.ch == '*') || sc.ch == '!') {
  87                 if (sc.MatchIgnoreCase("cdec$") || sc.MatchIgnoreCase("*dec$") || sc.MatchIgnoreCase("!dec$") ||
  88                     sc.MatchIgnoreCase("cdir$") || sc.MatchIgnoreCase("*dir$") || sc.MatchIgnoreCase("!dir$") ||
  89                     sc.MatchIgnoreCase("cms$")  || sc.MatchIgnoreCase("*ms$")  || sc.MatchIgnoreCase("!ms$")  ||
  90                     sc.chNext == '$') {
  91                     sc.SetState(SCE_F_PREPROCESSOR);
  92                                 } else {
  93                                         sc.SetState(SCE_F_COMMENT);
  94                                 }
  95
  96                                 while (!sc.atLineEnd && sc.More()) sc.Forward(); // Until line end
  97                         } else if (toLineStart > 72) {
  98                                 sc.SetState(SCE_F_COMMENT);
  99                                 while (!sc.atLineEnd && sc.More()) sc.Forward(); // Until line end
 100                         } else if (toLineStart < 5) {
 101                                 if (IsADigit(sc.ch))
 102                                         sc.SetState(SCE_F_LABEL);
 103                                 else
 104                                         sc.SetState(SCE_F_DEFAULT);
 105                         } else if (toLineStart == 5) {
 106                                 if (!IsASpace(sc.ch) && sc.ch != '0') {
 107                                         sc.SetState(SCE_F_CONTINUATION);
 108                                         sc.ForwardSetState(prevState);
 109                                 } else
 110                                         sc.SetState(SCE_F_DEFAULT);
 111                         }
 112                         continue;
 113                 }
 114                 /***************************************/
 115                 // Handle line continuation generically.
 116                 if (!isFixFormat && sc.ch == '&') {
 117                         char chTemp = ' ';
 118                         int j = 1;
 119                         while (IsABlank(chTemp) && j<132) {
 120                                 chTemp = static_cast<char>(sc.GetRelative(j));
 121                                 j++;
 122                         }
 123                         if (chTemp == '!') {
 124                                 sc.SetState(SCE_F_CONTINUATION);
 125                                 if (sc.chNext == '!') sc.ForwardSetState(SCE_F_COMMENT);
 126                         } else if (chTemp == '\r' || chTemp == '\n') {
 127                                 int currentState = sc.state;
 128                                 sc.SetState(SCE_F_CONTINUATION);
 129                                 sc.ForwardSetState(SCE_F_DEFAULT);
 130                                 while (IsASpace(sc.ch) && sc.More()) sc.Forward();
 131                                 if (sc.ch == '&') {
 132                                         sc.SetState(SCE_F_CONTINUATION);
 133                                         sc.Forward();
 134                                 }
 135                                 sc.SetState(currentState);
 136                         }
 137                 }
 138                 /***************************************/
 139                 // Determine if the current state should terminate.
 140                 if (sc.state == SCE_F_OPERATOR) {
 141                         sc.SetState(SCE_F_DEFAULT);
 142                 } else if (sc.state == SCE_F_NUMBER) {
 143                         if (!(IsAWordChar(sc.ch) || sc.ch=='\'' || sc.ch=='\"' || sc.ch=='.')) {
 144                                 sc.SetState(SCE_F_DEFAULT);
 145                         }
 146                 } else if (sc.state == SCE_F_IDENTIFIER) {
 147                         if (!IsAWordChar(sc.ch) || (sc.ch == '%')) {
 148                                 char s[100];
 149                                 sc.GetCurrentLowered(s, sizeof(s));
 150                                 if (keywords.InList(s)) {
 151                                         sc.ChangeState(SCE_F_WORD);
 152                                 } else if (keywords2.InList(s)) {
 153                                         sc.ChangeState(SCE_F_WORD2);
 154                                 } else if (keywords3.InList(s)) {
 155                                         sc.ChangeState(SCE_F_WORD3);
 156                                 }
 157                                 sc.SetState(SCE_F_DEFAULT);
 158                         }
 159                 } else if (sc.state == SCE_F_COMMENT || sc.state == SCE_F_PREPROCESSOR) {
 160                         if (sc.ch == '\r' || sc.ch == '\n') {
 161                                 sc.SetState(SCE_F_DEFAULT);
 162                         }
 163                 } else if (sc.state == SCE_F_STRING1) {
 164                         prevState = sc.state;
 165                         if (sc.ch == '\'') {
 166                                 if (sc.chNext == '\'') {
 167                                         sc.Forward();
 168                                 } else {
 169                                         sc.ForwardSetState(SCE_F_DEFAULT);
 170                                         prevState = SCE_F_DEFAULT;
 171                                 }
 172                         } else if (sc.atLineEnd) {
 173                                 sc.ChangeState(SCE_F_STRINGEOL);
 174                                 sc.ForwardSetState(SCE_F_DEFAULT);
 175                         }
 176                 } else if (sc.state == SCE_F_STRING2) {
 177                         prevState = sc.state;
 178                         if (sc.atLineEnd) {
 179                                 sc.ChangeState(SCE_F_STRINGEOL);
 180                                 sc.ForwardSetState(SCE_F_DEFAULT);
 181                         } else if (sc.ch == '\"') {
 182                                 if (sc.chNext == '\"') {
 183                                         sc.Forward();
 184                                 } else {
 185                                         sc.ForwardSetState(SCE_F_DEFAULT);
 186                                         prevState = SCE_F_DEFAULT;
 187                                 }
 188                         }
 189                 } else if (sc.state == SCE_F_OPERATOR2) {
 190                         if (sc.ch == '.') {
 191                                 sc.ForwardSetState(SCE_F_DEFAULT);
 192                         }
 193                 } else if (sc.state == SCE_F_CONTINUATION) {
 194                         sc.SetState(SCE_F_DEFAULT);
 195                 } else if (sc.state == SCE_F_LABEL) {
 196                         if (!IsADigit(sc.ch)) {
 197                                 sc.SetState(SCE_F_DEFAULT);
 198                         } else {
 199                                 if (isFixFormat && sc.currentPos-posLineStart > 4)
 200                                         sc.SetState(SCE_F_DEFAULT);
 201                                 else if (numNonBlank > 5)
 202                                         sc.SetState(SCE_F_DEFAULT);
 203                         }
 204                 }
 205                 /***************************************/
 206                 // Determine if a new state should be entered.
 207                 if (sc.state == SCE_F_DEFAULT) {
 208                         if (sc.ch == '!') {
 209                 if (sc.MatchIgnoreCase("!dec$") || sc.MatchIgnoreCase("!dir$") ||
 210                     sc.MatchIgnoreCase("!ms$") || sc.chNext == '$') {
 211                                         sc.SetState(SCE_F_PREPROCESSOR);
 212                                 } else {
 213                                         sc.SetState(SCE_F_COMMENT);
 214                                 }
 215                         } else if ((!isFixFormat) && IsADigit(sc.ch) && numNonBlank == 1) {
 216                                 sc.SetState(SCE_F_LABEL);
 217                         } else if (IsADigit(sc.ch) || (sc.ch == '.' && IsADigit(sc.chNext))) {
 218                                 sc.SetState(SCE_F_NUMBER);
 219                         } else if ((tolower(sc.ch) == 'b' || tolower(sc.ch) == 'o' ||
 220                                             tolower(sc.ch) == 'z') && (sc.chNext == '\"' || sc.chNext == '\'')) {
 221                                 sc.SetState(SCE_F_NUMBER);
 222                                 sc.Forward();
 223                         } else if (sc.ch == '.' && isalpha(sc.chNext)) {
 224                                 sc.SetState(SCE_F_OPERATOR2);
 225                         } else if (IsAWordStart(sc.ch)) {
 226                                 sc.SetState(SCE_F_IDENTIFIER);
 227                         } else if (sc.ch == '\"') {
 228                                 sc.SetState(SCE_F_STRING2);
 229                         } else if (sc.ch == '\'') {
 230                                 sc.SetState(SCE_F_STRING1);
 231                         } else if (isoperator(static_cast<char>(sc.ch))) {
 232                                 sc.SetState(SCE_F_OPERATOR);
 233                         }
 234                 }
 235         }
 236         sc.Complete();
 237 }
 238 /***************************************/
 239 // To determine the folding level depending on keywords
 240 static int classifyFoldPointFortran(const char* s, const char* prevWord, const char chNextNonBlank) {
 241         int lev = 0;
 242         if ((strcmp(prevWord, "else") == 0 && strcmp(s, "if") == 0) || strcmp(s, "elseif") == 0)
 243                 return -1;
 244         if (strcmp(s, "associate") == 0 || strcmp(s, "block") == 0
 245             || strcmp(s, "blockdata") == 0 || strcmp(s, "select") == 0
 246             || strcmp(s, "do") == 0 || strcmp(s, "enum") ==0
 247             || strcmp(s, "function") == 0 || strcmp(s, "interface") == 0
 248                 || strcmp(s, "module") == 0 || strcmp(s, "program") == 0
 249                 || strcmp(s, "subroutine") == 0 || strcmp(s, "then") == 0
 250                 || (strcmp(s, "type") == 0 && chNextNonBlank != '(') ){
 251                         if (strcmp(prevWord, "end") == 0)
 252                                 lev = 0;
 253                         else
 254                                 lev = 1;
 255         } else if (strcmp(s, "end") == 0 && chNextNonBlank != '='
 256                 || strcmp(s, "endassociate") == 0 || strcmp(s, "endblock") == 0
 257                 || strcmp(s, "endblockdata") == 0 || strcmp(s, "endselect") == 0
 258                 || strcmp(s, "enddo") == 0 || strcmp(s, "endenum") ==0
 259                 || strcmp(s, "endif") == 0 || strcmp(s, "endforall") == 0
 260                 || strcmp(s, "endfunction") == 0 || strcmp(s, "endinterface") == 0
 261                 || strcmp(s, "endmodule") == 0 || strcmp(s, "endprogram") == 0
 262                 || strcmp(s, "endsubroutine") == 0 || strcmp(s, "endtype") == 0
 263                 || strcmp(s, "endwhere") == 0
 264                 || strcmp(s, "procedure") == 0 ) { // Take care of the module procedure statement
 265                         lev = -1;
 266         } else if (strcmp(prevWord, "end") == 0 && strcmp(s, "if") == 0){ // end if
 267                         lev = 0;
 268         }
 269         return lev;
 270 }
 271 // Folding the code
 272 static void FoldFortranDoc(unsigned int startPos, int length, int initStyle,
 273                                                    Accessor &styler, bool isFixFormat) {
 274         //
 275         // bool foldComment = styler.GetPropertyInt("fold.comment") != 0;
 276         // Do not know how to fold the comment at the moment.
 277         //
 278         bool foldCompact = styler.GetPropertyInt("fold.compact", 1) != 0;
 279         unsigned int endPos = startPos + length;
 280         int visibleChars = 0;
 281         int lineCurrent = styler.GetLine(startPos);
 282         int levelPrev = styler.LevelAt(lineCurrent) & SC_FOLDLEVELNUMBERMASK;
 283         int levelCurrent = levelPrev;
 284         char chNext = styler[startPos];
 285         char chNextNonBlank;
 286         int styleNext = styler.StyleAt(startPos);
 287         int style = initStyle;
 288         /***************************************/
 289         int lastStart = 0;
 290         char prevWord[32] = "";
 291         char Label[6] = "";
 292         // Variables for do label folding.
 293         static int doLabels[100];
 294         static int posLabel=-1;
 295         /***************************************/
 296         for (unsigned int i = startPos; i < endPos; i++) {
 297                 char ch = chNext;
 298                 chNext = styler.SafeGetCharAt(i + 1);
 299                 chNextNonBlank = chNext;
 300                 unsigned int j=i+1;
 301                 while(IsABlank(chNextNonBlank) && j<endPos) {
 302                         j ++ ;
 303                         chNextNonBlank = styler.SafeGetCharAt(j);
 304                 }
 305                 int stylePrev = style;
 306                 style = styleNext;
 307                 styleNext = styler.StyleAt(i + 1);
 308                 bool atEOL = (ch == '\r' && chNext != '\n') || (ch == '\n');
 309                 //
 310                 if (stylePrev == SCE_F_DEFAULT && (style == SCE_F_WORD || style == SCE_F_LABEL)) {
 311                         // Store last word and label start point.
 312                         lastStart = i;
 313                 }
 314                 /***************************************/
 315                 if (style == SCE_F_WORD) {
 316                         if(iswordchar(ch) && !iswordchar(chNext)) {
 317                                 char s[32];
 318                                 unsigned int k;
 319                                 for(k=0; (k<31 ) && (k<i-lastStart+1 ); k++) {
 320                                         s[k] = static_cast<char>(tolower(styler[lastStart+k]));
 321                                 }
 322                                 s[k] = '\0';
 323                                 // Handle the forall and where statement and structure.
 324                                 if (strcmp(s, "forall") == 0 || strcmp(s, "where") == 0) {
 325                                         if (strcmp(prevWord, "end") != 0) {
 326                                                 j = i + 1;
 327                                                 char chBrace = '(', chSeek = ')', ch1 = styler.SafeGetCharAt(j);
 328                                                 // Find the position of the first (
 329                                                 while (ch1 != chBrace && j<endPos) {
 330                                                         j++;
 331                                                         ch1 = styler.SafeGetCharAt(j);
 332                                                 }
 333                                                 char styBrace = styler.StyleAt(j);
 334                                                 int depth = 1;
 335                                                 char chAtPos;
 336                                                 char styAtPos;
 337                                                 while (j<endPos) {
 338                                                         j++;
 339                                                         chAtPos = styler.SafeGetCharAt(j);
 340                                                         styAtPos = styler.StyleAt(j);
 341                                                         if (styAtPos == styBrace) {
 342                                                                 if (chAtPos == chBrace) depth++;
 343                                                                 if (chAtPos == chSeek) depth--;
 344                                                                 if (depth == 0) break;
 345                                                         }
 346                                                 }
 347                                                 while (j<endPos) {
 348                                                         j++;
 349                                                         chAtPos = styler.SafeGetCharAt(j);
 350                                                         styAtPos = styler.StyleAt(j);
 351                                                         if (styAtPos == SCE_F_COMMENT || IsABlank(chAtPos)) continue;
 352                                                         if (isFixFormat) {
 353                                                                 if (!IsALineEnd(chAtPos)) {
 354                                                                         break;
 355                                                                 } else {
 356                                                                         if (lineCurrent < styler.GetLine(styler.Length()-1)) {
 357                                                                                 j = styler.LineStart(lineCurrent+1);
 358                                                                                 if (styler.StyleAt(j+5) == SCE_F_CONTINUATION) {
 359                                                                                         j += 5;
 360                                                                                         continue;
 361                                                                                 } else {
 362                                                                                         levelCurrent++;
 363                                                                                         break;
 364                                                                                 }
 365                                                                         }
 366                                                                 }
 367                                                         } else {
 368                                                                 if (chAtPos == '&' && styler.StyleAt(j) == SCE_F_CONTINUATION) {
 369                                                                         j = GetContinuedPos(j+1, styler);
 370                                                                         continue;
 371                                                                 } else if (IsALineEnd(chAtPos)) {
 372                                                                         levelCurrent ++;
 373                                                                         break;
 374                                                                 } else {
 375                                                                         break;
 376                                                                 }
 377                                                         }
 378                                                 }
 379                                         }
 380                                 } else {
 381                                         levelCurrent += classifyFoldPointFortran(s, prevWord, chNextNonBlank);
 382                                         // Store the do Labels into array
 383                                         if (strcmp(s, "do") == 0 && IsADigit(chNextNonBlank)) {
 384                                                 unsigned int k = 0;
 385                                                 for (i=j; (i<j+5 && i<endPos); i++) {
 386                                                         ch = styler.SafeGetCharAt(i);
 387                                                         if (IsADigit(ch))
 388                                                                 Label[k++] = ch;
 389                                                         else
 390                                                                 break;
 391                                                 }
 392                                                 Label[k] = '\0';
 393                                                 posLabel ++;
 394                                                 doLabels[posLabel] = atoi(Label);
 395                                         }
 396                                 }
 397                                 strcpy(prevWord, s);
 398                         }
 399                 } else if (style == SCE_F_LABEL) {
 400                         if(IsADigit(ch) && !IsADigit(chNext)) {
 401                                 for(j = 0; ( j < 5 ) && ( j < i-lastStart+1 ); j++) {
 402                                         ch = styler.SafeGetCharAt(lastStart + j);
 403                                         if (IsADigit(ch) && styler.StyleAt(lastStart+j) == SCE_F_LABEL)
 404                                                 Label[j] = ch;
 405                                         else
 406                                                 break;
 407                                 }
 408                                 Label[j] = '\0';
 409                                 while (doLabels[posLabel] == atoi(Label) && posLabel > -1) {
 410                                         levelCurrent--;
 411                                         posLabel--;
 412                                 }
 413                         }
 414                 }
 415                 if (atEOL) {
 416                         int lev = levelPrev;
 417                         if (visibleChars == 0 && foldCompact)
 418                                 lev |= SC_FOLDLEVELWHITEFLAG;
 419                         if ((levelCurrent > levelPrev) && (visibleChars > 0))
 420                                 lev |= SC_FOLDLEVELHEADERFLAG;
 421                         if (lev != styler.LevelAt(lineCurrent)) {
 422                                 styler.SetLevel(lineCurrent, lev);
 423                         }
 424                         lineCurrent++;
 425                         levelPrev = levelCurrent;
 426                         visibleChars = 0;
 427                         strcpy(prevWord, "");
 428                 }
 429                 /***************************************/
 430                 if (!isspacechar(ch)) visibleChars++;
 431         }
 432         /***************************************/
 433         // Fill in the real level of the next line, keeping the current flags as they will be filled in later
 434         int flagsNext = styler.LevelAt(lineCurrent) & ~SC_FOLDLEVELNUMBERMASK;
 435         styler.SetLevel(lineCurrent, levelPrev | flagsNext);
 436 }
 437 /***************************************/
 438 static const char * const FortranWordLists[] = {
 439         "Primary keywords and identifiers",
 440         "Intrinsic functions",
 441         "Extended and user defined functions",
 442         0,
 443 };
 444 /***************************************/
 445 static void ColouriseFortranDocFreeFormat(unsigned int startPos, int length, int initStyle, WordList *keywordlists[],
 446                             Accessor &styler) {
 447         ColouriseFortranDoc(startPos, length, initStyle, keywordlists, styler, false);
 448 }
 449 /***************************************/
 450 static void ColouriseFortranDocFixFormat(unsigned int startPos, int length, int initStyle, WordList *keywordlists[],
 451                             Accessor &styler) {
 452         ColouriseFortranDoc(startPos, length, initStyle, keywordlists, styler, true);
 453 }
 454 /***************************************/
 455 static void FoldFortranDocFreeFormat(unsigned int startPos, int length, int initStyle,
 456                 WordList *[], Accessor &styler) {
 457         FoldFortranDoc(startPos, length, initStyle,styler, false);
 458 }
 459 /***************************************/
 460 static void FoldFortranDocFixFormat(unsigned int startPos, int length, int initStyle,
 461                 WordList *[], Accessor &styler) {
 462         FoldFortranDoc(startPos, length, initStyle,styler, true);
 463 }
 464 /***************************************/
 465 LexerModule lmFortran(SCLEX_FORTRAN, ColouriseFortranDocFreeFormat, "fortran", FoldFortranDocFreeFormat, FortranWordLists);
 466 LexerModule lmF77(SCLEX_F77, ColouriseFortranDocFixFormat, "f77", FoldFortranDocFixFormat, FortranWordLists);