1 // Scintilla source code edit control 
   2 /** @file LexFortran.cxx 
   4  ** Writen by Chuan-jian Shen, Last changed Sep. 2003 
   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 /***************************************/ 
  14 /***************************************/ 
  18 #include "StyleContext.h" 
  20 #include "Scintilla.h" 
  22 /***********************************************/ 
  23 static inline bool IsAWordChar(const int ch
) { 
  24         return (ch 
< 0x80) && (isalnum(ch
) || ch 
== '_' || ch 
== '%'); 
  26 /**********************************************/ 
  27 static inline bool IsAWordStart(const int ch
) { 
  28         return (ch 
< 0x80) && (isalnum(ch
)); 
  30 /***************************************/ 
  31 inline bool IsABlank(unsigned int ch
) { 
  32     return (ch 
== ' ') || (ch 
== 0x09) || (ch 
== 0x0b) ; 
  34 /***************************************/ 
  35 inline bool IsALineEnd(char ch
) { 
  36     return ((ch 
== '\n') || (ch 
== '\r')) ; 
  38 /***************************************/ 
  39 unsigned int GetContinuedPos(unsigned int pos
, Accessor 
&styler
) { 
  40         while (!IsALineEnd(styler
.SafeGetCharAt(pos
++))) continue; 
  41         if (styler
.SafeGetCharAt(pos
) == '\n') pos
++; 
  42         while (IsABlank(styler
.SafeGetCharAt(pos
++))) continue; 
  43         char chCur 
= styler
.SafeGetCharAt(pos
); 
  45                 while (IsABlank(styler
.SafeGetCharAt(++pos
))) continue; 
  51 /***************************************/ 
  52 static void ColouriseFortranDoc(unsigned int startPos
, int length
, int initStyle
, 
  53                         WordList 
*keywordlists
[], Accessor 
&styler
, bool isFixFormat
) { 
  54         WordList 
&keywords 
= *keywordlists
[0]; 
  55         WordList 
&keywords2 
= *keywordlists
[1]; 
  56         WordList 
&keywords3 
= *keywordlists
[2]; 
  57         /***************************************/ 
  58         int posLineStart 
= 0, numNonBlank 
= 0, prevState 
= 0; 
  59         int endPos 
= startPos 
+ length
; 
  60         /***************************************/ 
  61         // backtrack to the nearest keyword 
  62         while ((startPos 
> 1) && (styler
.StyleAt(startPos
) != SCE_F_WORD
)) { 
  65         startPos 
= styler
.LineStart(styler
.GetLine(startPos
)); 
  66         initStyle 
= styler
.StyleAt(startPos 
- 1); 
  67         StyleContext 
sc(startPos
, endPos
-startPos
, initStyle
, styler
); 
  68         /***************************************/ 
  69         for (; sc
.More(); sc
.Forward()) { 
  70                 // remember the start position of the line 
  72                         posLineStart 
= sc
.currentPos
; 
  74                         sc
.SetState(SCE_F_DEFAULT
); 
  76                 if (!IsASpaceOrTab(sc
.ch
)) numNonBlank 
++; 
  77                 /***********************************************/ 
  78                 // Handle the fix format generically 
  79                 int toLineStart 
= sc
.currentPos 
- posLineStart
; 
  80                 if (isFixFormat 
&& (toLineStart 
< 6 || toLineStart 
> 72)) { 
  81                         if (toLineStart 
== 0 && (tolower(sc
.ch
) == 'c' || sc
.ch 
== '*') || sc
.ch 
== '!') { 
  82                                 sc
.SetState(SCE_F_COMMENT
); 
  83                                 while (!sc
.atLineEnd 
&& sc
.More()) sc
.Forward(); // Until line end 
  84                         } else if (toLineStart 
> 72) { 
  85                                 sc
.SetState(SCE_F_COMMENT
); 
  86                                 while (!sc
.atLineEnd 
&& sc
.More()) sc
.Forward(); // Until line end 
  87                         } else if (toLineStart 
< 5) { 
  89                                         sc
.SetState(SCE_F_LABEL
); 
  91                                         sc
.SetState(SCE_F_DEFAULT
); 
  92                         } else if (toLineStart 
== 5) { 
  93                                 if (!IsASpace(sc
.ch
) && sc
.ch 
!= '0') { 
  94                                         sc
.SetState(SCE_F_CONTINUATION
); 
  95                                         sc
.ForwardSetState(prevState
); 
  97                                         sc
.SetState(SCE_F_DEFAULT
); 
 101                 /***************************************/ 
 102                 // Handle line continuation generically. 
 103                 if (!isFixFormat 
&& sc
.ch 
== '&') { 
 106                         while (IsABlank(chTemp
) && j
<132) { 
 107                                 chTemp 
= static_cast<char>(sc
.GetRelative(j
)); 
 111                                 sc
.SetState(SCE_F_CONTINUATION
); 
 112                                 if (sc
.chNext 
== '!') sc
.ForwardSetState(SCE_F_COMMENT
); 
 113                         } else if (chTemp 
== '\r' || chTemp 
== '\n') { 
 114                                 int currentState 
= sc
.state
; 
 115                                 sc
.SetState(SCE_F_CONTINUATION
); 
 116                                 sc
.ForwardSetState(SCE_F_DEFAULT
); 
 117                                 while (IsASpace(sc
.ch
) && sc
.More()) sc
.Forward(); 
 119                                         sc
.SetState(SCE_F_CONTINUATION
); 
 122                                 sc
.SetState(currentState
); 
 125                 /***************************************/ 
 126                 // Determine if the current state should terminate. 
 127                 if (sc
.state 
== SCE_F_OPERATOR
) { 
 128                         sc
.SetState(SCE_F_DEFAULT
); 
 129                 } else if (sc
.state 
== SCE_F_NUMBER
) { 
 130                         if (!(IsAWordChar(sc
.ch
) || sc
.ch
=='\'' || sc
.ch
=='\"' || sc
.ch
=='.')) { 
 131                                 sc
.SetState(SCE_F_DEFAULT
); 
 133                 } else if (sc
.state 
== SCE_F_IDENTIFIER
) { 
 134                         if (!IsAWordChar(sc
.ch
) || (sc
.ch 
== '%')) { 
 136                                 sc
.GetCurrentLowered(s
, sizeof(s
)); 
 137                                 if (keywords
.InList(s
)) { 
 138                                         sc
.ChangeState(SCE_F_WORD
); 
 139                                 } else if (keywords2
.InList(s
)) { 
 140                                         sc
.ChangeState(SCE_F_WORD2
); 
 141                                 } else if (keywords3
.InList(s
)) { 
 142                                         sc
.ChangeState(SCE_F_WORD3
); 
 144                                 sc
.SetState(SCE_F_DEFAULT
); 
 146                 } else if (sc
.state 
== SCE_F_COMMENT 
|| sc
.state 
== SCE_F_PREPROCESSOR
) { 
 147                         if (sc
.ch 
== '\r' || sc
.ch 
== '\n') { 
 148                                 sc
.SetState(SCE_F_DEFAULT
); 
 150                 } else if (sc
.state 
== SCE_F_STRING1
) { 
 151                         prevState 
= sc
.state
; 
 153                                 if (sc
.chNext 
== '\'') { 
 156                                         sc
.ForwardSetState(SCE_F_DEFAULT
); 
 157                                         prevState 
= SCE_F_DEFAULT
; 
 159                         } else if (sc
.atLineEnd
) { 
 160                                 sc
.ChangeState(SCE_F_STRINGEOL
); 
 161                                 sc
.ForwardSetState(SCE_F_DEFAULT
); 
 163                 } else if (sc
.state 
== SCE_F_STRING2
) { 
 164                         prevState 
= sc
.state
; 
 166                                 sc
.ChangeState(SCE_F_STRINGEOL
); 
 167                                 sc
.ForwardSetState(SCE_F_DEFAULT
); 
 168                         } else if (sc
.ch 
== '\"') { 
 169                                 if (sc
.chNext 
== '\"') { 
 172                                         sc
.ForwardSetState(SCE_F_DEFAULT
); 
 173                                         prevState 
= SCE_F_DEFAULT
; 
 176                 } else if (sc
.state 
== SCE_F_OPERATOR2
) { 
 178                                 sc
.ForwardSetState(SCE_F_DEFAULT
); 
 180                 } else if (sc
.state 
== SCE_F_CONTINUATION
) { 
 181                         sc
.SetState(SCE_F_DEFAULT
); 
 182                 } else if (sc
.state 
== SCE_F_LABEL
) { 
 183                         if (!IsADigit(sc
.ch
)) { 
 184                                 sc
.SetState(SCE_F_DEFAULT
); 
 186                                 if (isFixFormat 
&& sc
.currentPos
-posLineStart 
> 4) 
 187                                         sc
.SetState(SCE_F_DEFAULT
); 
 188                                 else if (numNonBlank 
> 5) 
 189                                         sc
.SetState(SCE_F_DEFAULT
); 
 192                 /***************************************/ 
 193                 // Determine if a new state should be entered. 
 194                 if (sc
.state 
== SCE_F_DEFAULT
) { 
 196                                 if (sc
.chNext 
== '$') { 
 197                                         sc
.SetState(SCE_F_PREPROCESSOR
); 
 199                                         sc
.SetState(SCE_F_COMMENT
); 
 201                         } else if ((!isFixFormat
) && IsADigit(sc
.ch
) && numNonBlank 
== 1) { 
 202                                 sc
.SetState(SCE_F_LABEL
); 
 203                         } else if (IsADigit(sc
.ch
) || (sc
.ch 
== '.' && IsADigit(sc
.chNext
))) { 
 204                                 sc
.SetState(SCE_F_NUMBER
); 
 205                         } else if ((tolower(sc
.ch
) == 'b' || tolower(sc
.ch
) == 'o' || 
 206                                             tolower(sc
.ch
) == 'z') && (sc
.chNext 
== '\"' || sc
.chNext 
== '\'')) { 
 207                                 sc
.SetState(SCE_F_NUMBER
); 
 209                         } else if (sc
.ch 
== '.' && isalpha(sc
.chNext
)) { 
 210                                 sc
.SetState(SCE_F_OPERATOR2
); 
 211                         } else if (IsAWordStart(sc
.ch
)) { 
 212                                 sc
.SetState(SCE_F_IDENTIFIER
); 
 213                         } else if (sc
.ch 
== '\"') { 
 214                                 sc
.SetState(SCE_F_STRING2
); 
 215                         } else if (sc
.ch 
== '\'') { 
 216                                 sc
.SetState(SCE_F_STRING1
); 
 217                         } else if (isoperator(static_cast<char>(sc
.ch
))) { 
 218                                 sc
.SetState(SCE_F_OPERATOR
); 
 224 /***************************************/ 
 225 // To determine the folding level depending on keywords 
 226 static int classifyFoldPointFortran(const char* s
, const char* prevWord
, const char chNextNonBlank
) { 
 228         if ((strcmp(prevWord
, "else") == 0 && strcmp(s
, "if") == 0) || strcmp(s
, "elseif") == 0) 
 230         if (strcmp(s
, "associate") == 0 || strcmp(s
, "block") == 0 
 231             || strcmp(s
, "blockdata") == 0 || strcmp(s
, "select") == 0 
 232             || strcmp(s
, "do") == 0 || strcmp(s
, "enum") ==0 
 233             || strcmp(s
, "function") == 0 || strcmp(s
, "interface") == 0 
 234                 || strcmp(s
, "module") == 0 || strcmp(s
, "program") == 0 
 235                 || strcmp(s
, "subroutine") == 0 || strcmp(s
, "then") == 0 
 236                 || (strcmp(s
, "type") == 0 && chNextNonBlank 
!= '(') ){ 
 237                         if (strcmp(prevWord
, "end") == 0) 
 241         } else if (strcmp(s
, "end") == 0 && chNextNonBlank 
!= '=' 
 242                 || strcmp(s
, "endassociate") == 0 || strcmp(s
, "endblock") == 0 
 243                 || strcmp(s
, "endblockdata") == 0 || strcmp(s
, "endselect") == 0 
 244                 || strcmp(s
, "enddo") == 0 || strcmp(s
, "endenum") ==0 
 245                 || strcmp(s
, "endif") == 0 || strcmp(s
, "endforall") == 0 
 246                 || strcmp(s
, "endfunction") == 0 || strcmp(s
, "endinterface") == 0 
 247                 || strcmp(s
, "endmodule") == 0 || strcmp(s
, "endprogram") == 0 
 248                 || strcmp(s
, "endsubroutine") == 0 || strcmp(s
, "endtype") == 0 
 249                 || strcmp(s
, "endwhere") == 0 
 250                 || strcmp(s
, "procedure") == 0 ) { // Take care of the module procedure statement 
 252         } else if (strcmp(prevWord
, "end") == 0 && strcmp(s
, "if") == 0){ // end if 
 258 static void FoldFortranDoc(unsigned int startPos
, int length
, int initStyle
, 
 259                                                    Accessor 
&styler
, bool isFixFormat
) { 
 261         // bool foldComment = styler.GetPropertyInt("fold.comment") != 0; 
 262         // Do not know how to fold the comment at the moment. 
 264         bool foldCompact 
= styler
.GetPropertyInt("fold.compact", 1) != 0; 
 265         unsigned int endPos 
= startPos 
+ length
; 
 266         int visibleChars 
= 0; 
 267         int lineCurrent 
= styler
.GetLine(startPos
); 
 268         int levelPrev 
= styler
.LevelAt(lineCurrent
) & SC_FOLDLEVELNUMBERMASK
; 
 269         int levelCurrent 
= levelPrev
; 
 270         char chNext 
= styler
[startPos
]; 
 272         int styleNext 
= styler
.StyleAt(startPos
); 
 273         int style 
= initStyle
; 
 274         /***************************************/ 
 276         char prevWord
[32] = "", Label
[6] = ""; 
 277         // Variables for do label folding. 
 278         static int doLabels
[100], posLabel
=-1; 
 279         /***************************************/ 
 280         for (unsigned int i 
= startPos
; i 
< endPos
; i
++) { 
 282                 chNext 
= styler
.SafeGetCharAt(i 
+ 1); 
 283                 chNextNonBlank 
= chNext
; 
 285                 while(IsABlank(chNextNonBlank
) && j
<endPos
) { 
 287                         chNextNonBlank 
= styler
.SafeGetCharAt(j
); 
 289                 int stylePrev 
= style
; 
 291                 styleNext 
= styler
.StyleAt(i 
+ 1); 
 292                 bool atEOL 
= (ch 
== '\r' && chNext 
!= '\n') || (ch 
== '\n'); 
 294                 if (stylePrev 
== SCE_F_DEFAULT 
&& (style 
== SCE_F_WORD 
|| style 
== SCE_F_LABEL
)) { 
 295                         // Store last word and label start point. 
 298                 /***************************************/ 
 299                 if (style 
== SCE_F_WORD
) { 
 300                         if(iswordchar(ch
) && !iswordchar(chNext
)) { 
 303                                 for(k
=0; (k
<31 ) && (k
<i
-lastStart
+1 ); k
++) { 
 304                                         s
[k
] = static_cast<char>(tolower(styler
[lastStart
+k
])); 
 307                                 // Handle the forall and where statement and structure. 
 308                                 if (strcmp(s
, "forall") == 0 || strcmp(s
, "where") == 0) { 
 309                                         if (strcmp(prevWord
, "end") != 0) { 
 311                                                 char chBrace 
= '(', chSeek 
= ')', ch1 
= styler
.SafeGetCharAt(j
); 
 312                                                 // Find the position of the first ( 
 313                                                 while (ch1 
!= chBrace 
&& j
<endPos
) { 
 315                                                         ch1 
= styler
.SafeGetCharAt(j
); 
 317                                                 char styBrace 
= styler
.StyleAt(j
); 
 323                                                         chAtPos 
= styler
.SafeGetCharAt(j
); 
 324                                                         styAtPos 
= styler
.StyleAt(j
); 
 325                                                         if (styAtPos 
== styBrace
) { 
 326                                                                 if (chAtPos 
== chBrace
) depth
++; 
 327                                                                 if (chAtPos 
== chSeek
) depth
--; 
 328                                                                 if (depth 
== 0) break; 
 333                                                         chAtPos 
= styler
.SafeGetCharAt(j
); 
 334                                                         styAtPos 
= styler
.StyleAt(j
); 
 335                                                         if (styAtPos 
== SCE_F_COMMENT 
|| IsABlank(chAtPos
)) continue; 
 337                                                                 if (!IsALineEnd(chAtPos
)) { 
 340                                                                         if (lineCurrent 
< styler
.GetLine(styler
.Length()-1)) { 
 341                                                                                 j 
= styler
.LineStart(lineCurrent
+1); 
 342                                                                                 if (styler
.StyleAt(j
+5) == SCE_F_CONTINUATION
) { 
 352                                                                 if (chAtPos 
== '&' && styler
.StyleAt(j
) == SCE_F_CONTINUATION
) { 
 353                                                                         j 
= GetContinuedPos(j
+1, styler
); 
 355                                                                 } else if (IsALineEnd(chAtPos
)) { 
 365                                         levelCurrent 
+= classifyFoldPointFortran(s
, prevWord
, chNextNonBlank
); 
 366                                         // Store the do Labels into array 
 367                                         if (strcmp(s
, "do") == 0 && IsADigit(chNextNonBlank
)) { 
 369                                                 for (i
=j
; (i
<j
+5 && i
<endPos
); i
++) { 
 370                                                         ch 
= styler
.SafeGetCharAt(i
); 
 378                                                 doLabels
[posLabel
] = atoi(Label
); 
 383                 } else if (style 
== SCE_F_LABEL
) { 
 384                         if(IsADigit(ch
) && !IsADigit(chNext
)) { 
 385                                 for(j 
= 0; ( j 
< 5 ) && ( j 
< i
-lastStart
+1 ); j
++) { 
 386                                         ch 
= styler
.SafeGetCharAt(lastStart 
+ j
); 
 387                                         if (IsADigit(ch
) && styler
.StyleAt(lastStart
+j
) == SCE_F_LABEL
) 
 393                                 while (doLabels
[posLabel
] == atoi(Label
) && posLabel 
> -1) { 
 401                         if (visibleChars 
== 0 && foldCompact
) 
 402                                 lev 
|= SC_FOLDLEVELWHITEFLAG
; 
 403                         if ((levelCurrent 
> levelPrev
) && (visibleChars 
> 0)) 
 404                                 lev 
|= SC_FOLDLEVELHEADERFLAG
; 
 405                         if (lev 
!= styler
.LevelAt(lineCurrent
)) { 
 406                                 styler
.SetLevel(lineCurrent
, lev
); 
 409                         levelPrev 
= levelCurrent
; 
 411                         strcpy(prevWord
, ""); 
 413                 /***************************************/ 
 414                 if (!isspacechar(ch
)) visibleChars
++; 
 416         /***************************************/ 
 417         // Fill in the real level of the next line, keeping the current flags as they will be filled in later 
 418         int flagsNext 
= styler
.LevelAt(lineCurrent
) & ~SC_FOLDLEVELNUMBERMASK
; 
 419         styler
.SetLevel(lineCurrent
, levelPrev 
| flagsNext
); 
 421 /***************************************/ 
 422 static const char * const FortranWordLists
[] = { 
 423         "Primary keywords and identifiers", 
 424         "Intrinsic functions", 
 425         "Extended and user defined functions", 
 428 /***************************************/ 
 429 static void ColouriseFortranDocFreeFormat(unsigned int startPos
, int length
, int initStyle
, WordList 
*keywordlists
[], 
 431         ColouriseFortranDoc(startPos
, length
, initStyle
, keywordlists
, styler
, false); 
 433 /***************************************/ 
 434 static void ColouriseFortranDocFixFormat(unsigned int startPos
, int length
, int initStyle
, WordList 
*keywordlists
[], 
 436         ColouriseFortranDoc(startPos
, length
, initStyle
, keywordlists
, styler
, true); 
 438 /***************************************/ 
 439 static void FoldFortranDocFreeFormat(unsigned int startPos
, int length
, int initStyle
, 
 440                 WordList 
*[], Accessor 
&styler
) { 
 441         FoldFortranDoc(startPos
, length
, initStyle
,styler
, false); 
 443 /***************************************/ 
 444 static void FoldFortranDocFixFormat(unsigned int startPos
, int length
, int initStyle
, 
 445                 WordList 
*[], Accessor 
&styler
) { 
 446         FoldFortranDoc(startPos
, length
, initStyle
,styler
, true); 
 448 /***************************************/ 
 449 LexerModule 
lmFortran(SCLEX_FORTRAN
, ColouriseFortranDocFreeFormat
, "fortran", FoldFortranDocFreeFormat
, FortranWordLists
); 
 450 LexerModule 
lmF77(SCLEX_F77
, ColouriseFortranDocFixFormat
, "f77", FoldFortranDocFixFormat
, FortranWordLists
);