f90.el 91.5 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1
;;; f90.el --- Fortran-90 mode (free format)
Erik Naggum's avatar
Erik Naggum committed
2

Glenn Morris's avatar
Glenn Morris committed
3
;; Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2006, 2007  Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
5

Gerd Moellmann's avatar
Gerd Moellmann committed
6
;; Author: Torbj\"orn Einarsson <Torbjorn.Einarsson@era.ericsson.se>
7
;; Maintainer: Glenn Morris <rgm@gnu.org>
Richard M. Stallman's avatar
Richard M. Stallman committed
8 9
;; Keywords: fortran, f90, languages

Erik Naggum's avatar
Erik Naggum committed
10 11 12
;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
13
;; it under the terms of the GNU General Public License as published by
14
;; the Free Software Foundation; either version 3, or (at your option)
Erik Naggum's avatar
Erik Naggum committed
15
;; any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
16

Erik Naggum's avatar
Erik Naggum committed
17
;; GNU Emacs is distributed in the hope that it will be useful,
Richard M. Stallman's avatar
Richard M. Stallman committed
18 19 20 21 22
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
23
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
24 25
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
26 27

;;; Commentary:
Erik Naggum's avatar
Erik Naggum committed
28

29 30
;; Major mode for editing F90 programs in FREE FORMAT.
;; The minor language revision F95 is also supported (with font-locking).
31
;; Some/many (?) aspects of F2003 are supported.
32

Richard M. Stallman's avatar
Richard M. Stallman committed
33
;; Knows about continuation lines, named structured statements, and other
34 35
;; features in F90 including HPF (High Performance Fortran) structures.
;; The basic feature provides accurate indentation of F90 programs.
Richard M. Stallman's avatar
Richard M. Stallman committed
36 37
;; In addition, there are many more features like automatic matching of all
;; end statements, an auto-fill function to break long lines, a join-lines
38 39 40 41 42 43
;; function which joins continued lines, etc.

;; To facilitate typing, a fairly complete list of abbreviations is provided.
;; All abbreviations begin with the backquote character "`"
;; (this requires modification of the syntax-table).
;; For example, `i expands to integer (if abbrev-mode is on).
Richard M. Stallman's avatar
Richard M. Stallman committed
44

45
;; There are two separate features for altering the appearance of code:
Richard M. Stallman's avatar
Richard M. Stallman committed
46
;;   1) Upcasing or capitalizing of all keywords.
47 48 49
;;   2) Colors/fonts using font-lock-mode.
;; Automatic upcase or downcase of keywords is controlled by the variable
;; f90-auto-keyword-case.
Richard M. Stallman's avatar
Richard M. Stallman committed
50 51

;; The indentations of lines starting with ! is determined by the first of the
52
;; following matches (values in the left column are the defaults):
Karl Heuer's avatar
Karl Heuer committed
53 54 55 56 57 58 59 60 61 62 63 64 65

;; start-string/regexp  indent         variable holding start-string/regexp
;;    !!!                  0
;;    !hpf\\$ (re)         0              f90-directive-comment-re
;;    !!$                  0              f90-comment-region
;;    !      (re)        as code          f90-indented-comment-re
;;    default            comment-column

;; Ex: Here is the result of 3 different settings of f90-indented-comment-re
;;     f90-indented-comment-re  !-indentation      !!-indentation
;;          !                    as code             as code
;;          !!                   comment-column      as code
;;          ![^!]                as code             comment-column
66 67 68
;; Trailing comments are indented to comment-column with indent-for-comment.
;; The function f90-comment-region toggles insertion of
;; the variable f90-comment-region in every line of the region.
Richard M. Stallman's avatar
Richard M. Stallman committed
69

70
;; One common convention for free vs. fixed format is that free format files
Glenn Morris's avatar
Glenn Morris committed
71
;; have the ending .f90 or .f95 while fixed format files have the ending .f.
72 73 74 75 76
;; Emacs automatically loads Fortran files in the appropriate mode based
;; on extension. You can modify this by adjusting the variable auto-mode-alist.
;; For example:
;; (add-to-list 'auto-mode-alist '("\\.f\\'" . f90-mode))

Richard M. Stallman's avatar
Richard M. Stallman committed
77
;; Once you have entered f90-mode, you may get more info by using
Glenn Morris's avatar
Glenn Morris committed
78
;; the command describe-mode (C-h m). For online help use
79 80
;; C-h f <Name of function you want described>, or
;; C-h v <Name of variable you want described>.
Richard M. Stallman's avatar
Richard M. Stallman committed
81

82 83 84
;; To customize f90-mode for your taste, use, for example:
;; (you don't have to specify values for all the parameters below)
;;
85
;;(add-hook 'f90-mode-hook
86
;;      ;; These are the default values.
Richard M. Stallman's avatar
Richard M. Stallman committed
87 88 89 90 91 92
;;      '(lambda () (setq f90-do-indent 3
;;                        f90-if-indent 3
;;                        f90-type-indent 3
;;                        f90-program-indent 2
;;                        f90-continuation-indent 5
;;                        f90-comment-region "!!$"
Karl Heuer's avatar
Karl Heuer committed
93 94
;;                        f90-directive-comment-re "!hpf\\$"
;;                        f90-indented-comment-re "!"
95
;;                        f90-break-delimiters "[-+\\*/><=,% \t]"
Richard M. Stallman's avatar
Richard M. Stallman committed
96 97 98 99
;;                        f90-break-before-delimiters t
;;                        f90-beginning-ampersand t
;;                        f90-smart-end 'blink
;;                        f90-auto-keyword-case nil
100
;;                        f90-leave-line-no nil
101
;;                        indent-tabs-mode nil
102
;;                        f90-font-lock-keywords f90-font-lock-keywords-2
103
;;                  )
104
;;       ;; These are not default.
Richard M. Stallman's avatar
Richard M. Stallman committed
105
;;       (abbrev-mode 1)             ; turn on abbreviation mode
106
;;       (f90-add-imenu-menu)        ; extra menu with functions etc.
Richard M. Stallman's avatar
Richard M. Stallman committed
107 108
;;       (if f90-auto-keyword-case   ; change case of all keywords on startup
;;           (f90-change-keywords f90-auto-keyword-case))
Glenn Morris's avatar
Glenn Morris committed
109
;;       ))
110 111 112 113 114
;;
;; in your .emacs file. You can also customize the lists
;; f90-font-lock-keywords, etc.
;;
;; The auto-fill and abbreviation minor modes are accessible from the F90 menu,
115
;; or by using M-x auto-fill-mode and M-x abbrev-mode, respectively.
Richard M. Stallman's avatar
Richard M. Stallman committed
116 117 118 119

;; Remarks
;; 1) Line numbers are by default left-justified. If f90-leave-line-no is
;;    non-nil, the line numbers are never touched.
120
;; 2) Multi-; statements like "do i=1,20 ; j=j+i ; end do" are not handled
Richard M. Stallman's avatar
Richard M. Stallman committed
121
;;    correctly, but I imagine them to be rare.
Karl Heuer's avatar
Karl Heuer committed
122
;; 3) Regexps for hilit19 are no longer supported.
123
;; 4) For FIXED FORMAT code, use fortran mode.
Richard M. Stallman's avatar
Richard M. Stallman committed
124
;; 5) This mode does not work under emacs-18.x.
125 126 127
;; 6) Preprocessor directives, i.e., lines starting with # are left-justified
;;    and are untouched by all case-changing commands. There is, at present, no
;;    mechanism for treating multi-line directives (continued by \ ).
Karl Heuer's avatar
Karl Heuer committed
128 129
;; 7) f77 do-loops do 10 i=.. ; ; 10 continue are not correctly indented.
;;    You are urged to use f90-do loops (with labels if you wish).
130
;; 8) The highlighting mode under XEmacs is not as complete as under Emacs.
Richard M. Stallman's avatar
Richard M. Stallman committed
131 132 133 134 135 136 137 138 139 140 141 142 143 144

;; List of user commands
;;   f90-previous-statement         f90-next-statement
;;   f90-beginning-of-subprogram    f90-end-of-subprogram   f90-mark-subprogram
;;   f90-comment-region
;;   f90-indent-line                f90-indent-new-line
;;   f90-indent-region    (can be called by calling indent-region)
;;   f90-indent-subprogram
;;   f90-break-line                 f90-join-lines
;;   f90-fill-region
;;   f90-insert-end
;;   f90-upcase-keywords            f90-upcase-region-keywords
;;   f90-downcase-keywords          f90-downcase-region-keywords
;;   f90-capitalize-keywords        f90-capitalize-region-keywords
145 146
;;   f90-add-imenu-menu
;;   f90-font-lock-1, f90-font-lock-2, f90-font-lock-3, f90-font-lock-4
Richard M. Stallman's avatar
Richard M. Stallman committed
147

148
;; Original author's thanks
Richard M. Stallman's avatar
Richard M. Stallman committed
149 150 151 152 153 154
;; Thanks to all the people who have tested the mode. Special thanks to Jens
;; Bloch Helmers for encouraging me to write this code, for creative
;; suggestions as well as for the lists of hpf-commands.
;; Also thanks to the authors of the fortran and pascal modes, on which some
;; of this code is built.

155 156
;;; Code:

157
;; TODO
158 159
;; 1. Any missing F2003 syntax?
;; 2. Have "f90-mode" just recognize F90 syntax, then derived modes
160
;; "f95-mode", "f2003-mode" for the language revisions.
161 162 163 164 165 166 167
;; 3. Support for align.
;; Font-locking:
;; 1. OpenMP, OpenMPI?, preprocessor highlighting.
;; 2. interface blah - Highlight "blah" in function-name face?
;; Need to avoid "interface operator (+)" etc.
;; 3. integer_name = 1
;; 4. Labels for "else" statements (F2003)?
168

169 170
(defvar comment-auto-fill-only-comments)
(defvar font-lock-keywords)
171

Richard M. Stallman's avatar
Richard M. Stallman committed
172 173
;; User options

174
(defgroup f90 nil
175
  "Major mode for editing free format Fortran 90,95 code."
176
  :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
177
  :group 'languages)
Richard M. Stallman's avatar
Richard M. Stallman committed
178

179
(defgroup f90-indent nil
180
  "Indentation in free format Fortran."
181
  :prefix "f90-"
182
  :group  'f90)
Richard M. Stallman's avatar
Richard M. Stallman committed
183 184


185
(defcustom f90-do-indent 3
186
  "Extra indentation applied to DO blocks."
187
  :type  'integer
188
  :group 'f90-indent)
Glenn Morris's avatar
Glenn Morris committed
189
(put 'f90-do-indent 'safe-local-variable 'integerp)
Richard M. Stallman's avatar
Richard M. Stallman committed
190

191
(defcustom f90-if-indent 3
192
  "Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks."
193
  :type  'integer
194
  :group 'f90-indent)
Glenn Morris's avatar
Glenn Morris committed
195
(put 'f90-if-indent 'safe-local-variable 'integerp)
Richard M. Stallman's avatar
Richard M. Stallman committed
196

197
(defcustom f90-type-indent 3
198
  "Extra indentation applied to TYPE, ENUM, INTERFACE and BLOCK DATA blocks."
199
  :type  'integer
200
  :group 'f90-indent)
Glenn Morris's avatar
Glenn Morris committed
201
(put 'f90-type-indent 'safe-local-variable 'integerp)
Richard M. Stallman's avatar
Richard M. Stallman committed
202

203
(defcustom f90-program-indent 2
204
  "Extra indentation applied to PROGRAM, MODULE, SUBROUTINE, FUNCTION blocks."
205
  :type  'integer
206
  :group 'f90-indent)
Glenn Morris's avatar
Glenn Morris committed
207
(put 'f90-program-indent 'safe-local-variable 'integerp)
Richard M. Stallman's avatar
Richard M. Stallman committed
208

209 210 211 212 213
(defcustom f90-associate-indent 2
  "Extra indentation applied to ASSOCIATE blocks."
  :type  'integer
  :group 'f90-indent
  :version "23.1")
Glenn Morris's avatar
Glenn Morris committed
214
(put 'f90-associate-indent 'safe-local-variable 'integerp)
215

216
(defcustom f90-continuation-indent 5
217
  "Extra indentation applied to continuation lines."
218
  :type  'integer
219
  :group 'f90-indent)
Glenn Morris's avatar
Glenn Morris committed
220
(put 'f90-continuation-indent 'safe-local-variable 'integerp)
Richard M. Stallman's avatar
Richard M. Stallman committed
221

222
(defcustom f90-comment-region "!!$"
223
  "String inserted by \\[f90-comment-region] at start of each line in region."
224
  :type  'string
225
  :group 'f90-indent)
Glenn Morris's avatar
Glenn Morris committed
226
(put 'f90-comment-region 'safe-local-variable 'stringp)
227 228

(defcustom f90-indented-comment-re "!"
229
  "Regexp matching comments to indent as code."
230
  :type  'regexp
231
  :group 'f90-indent)
232
(put 'f90-indented-comment-re 'safe-local-variable 'stringp)
233 234

(defcustom f90-directive-comment-re "!hpf\\$"
235
  "Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented."
236
  :type  'regexp
237
  :group 'f90-indent)
238
(put 'f90-directive-comment-re 'safe-local-variable 'stringp)
239 240

(defcustom f90-beginning-ampersand t
241
  "Non-nil gives automatic insertion of \& at start of continuation line."
242
  :type  'boolean
243
  :group 'f90)
Glenn Morris's avatar
Glenn Morris committed
244
(put 'f90-beginning-ampersand 'safe-local-variable 'booleanp)
245 246

(defcustom f90-smart-end 'blink
247
  "Qualification of END statements according to the matching block start.
248 249 250 251 252
For example, the END that closes an IF block is changed to END
IF.  If the block has a label, this is added as well.  Allowed
values are 'blink, 'no-blink, and nil.  If nil, nothing is done.
The other two settings have the same effect, but 'blink
additionally blinks the cursor to the start of the block."
253
  :type  '(choice (const blink) (const no-blink) (const nil))
254
  :group 'f90)
Glenn Morris's avatar
Glenn Morris committed
255 256
(put 'f90-smart-end 'safe-local-variable
     (lambda (value) (memq value '(blink no-blink nil))))
Richard M. Stallman's avatar
Richard M. Stallman committed
257

258
(defcustom f90-break-delimiters "[-+\\*/><=,% \t]"
259
  "Regexp matching delimiter characters at which lines may be broken.
260 261 262
There are certain tokens comprised entirely of characters
matching this regexp that should not be split, and these are
specified by the constant `f90-no-break-re'."
263
  :type  'regexp
264
  :group 'f90)
265
(put 'f90-break-delimiters 'safe-local-variable 'stringp)
Richard M. Stallman's avatar
Richard M. Stallman committed
266

267
(defcustom f90-break-before-delimiters t
268
  "Non-nil causes `f90-do-auto-fill' to break lines before delimiters."
269
  :type  'boolean
270
  :group 'f90)
Glenn Morris's avatar
Glenn Morris committed
271
(put 'f90-break-before-delimiters 'safe-local-variable 'booleanp)
Richard M. Stallman's avatar
Richard M. Stallman committed
272

273
(defcustom f90-auto-keyword-case nil
274
  "Automatic case conversion of keywords.
275
The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil."
276 277
  :type  '(choice (const downcase-word) (const upcase-word)
                  (const capitalize-word) (const nil))
278
  :group 'f90)
Glenn Morris's avatar
Glenn Morris committed
279 280 281
(put 'f90-auto-keyword-case 'safe-local-variable
     (lambda (value) (memq value '(downcase-word
                                   capitalize-word upcase-word nil))))
282 283

(defcustom f90-leave-line-no nil
284
  "If non-nil, line numbers are not left justified."
285
  :type  'boolean
286
  :group 'f90)
Glenn Morris's avatar
Glenn Morris committed
287
(put 'f90-leave-line-no 'safe-local-variable 'booleanp)
288

289 290
(defcustom f90-mode-hook nil
  "Hook run when entering F90 mode."
291
  :type    'hook
292
  :options '(f90-add-imenu-menu)
293
  :group   'f90)
Glenn Morris's avatar
Glenn Morris committed
294 295
(put 'f90-mode-hook 'safe-local-variable
     (lambda (value) (member value '((f90-add-imenu-menu) nil))))
296 297

;; User options end here.
298

Karl Heuer's avatar
Karl Heuer committed
299
(defconst f90-keywords-re
300
  (regexp-opt '("allocatable" "allocate" "assign" "assignment" "backspace"
Glenn Morris's avatar
Glenn Morris committed
301 302 303 304 305 306 307 308 309 310 311 312 313
                "block" "call" "case" "character" "close" "common" "complex"
                "contains" "continue" "cycle" "data" "deallocate"
                "dimension" "do" "double" "else" "elseif" "elsewhere" "end"
                "enddo" "endfile" "endif" "entry" "equivalence" "exit"
                "external" "forall" "format" "function" "goto" "if"
                "implicit" "include" "inquire" "integer" "intent"
                "interface" "intrinsic" "logical" "module" "namelist" "none"
                "nullify" "only" "open" "operator" "optional" "parameter"
                "pause" "pointer" "precision" "print" "private" "procedure"
                "program" "public" "read" "real" "recursive" "result" "return"
                "rewind" "save" "select" "sequence" "stop" "subroutine"
                "target" "then" "type" "use" "where" "while" "write"
                ;; F95 keywords.
314 315 316 317
                "elemental" "pure"
                ;; F2003
                "abstract" "associate" "asynchronous" "bind" "class"
                "deferred" "enum" "enumerator" "extends" "extends_type_of"
318 319
                "final" "generic" "import" "non_intrinsic" "non_overridable"
                "nopass" "pass" "protected" "same_type_as" "value" "volatile"
320
                ) 'words)
321
  "Regexp used by the function `f90-change-keywords'.")
Karl Heuer's avatar
Karl Heuer committed
322 323

(defconst f90-keywords-level-3-re
324 325 326 327
  (regexp-opt
   '("allocatable" "allocate" "assign" "assignment" "backspace"
     "close" "deallocate" "dimension" "endfile" "entry" "equivalence"
     "external" "inquire" "intent" "intrinsic" "nullify" "only" "open"
328
     ;; FIXME operator and assignment should be F2003 procedures?
329 330 331 332
     "operator" "optional" "parameter" "pause" "pointer" "print" "private"
     "public" "read" "recursive" "result" "rewind" "save" "select"
     "sequence" "target" "write"
     ;; F95 keywords.
333 334
     "elemental" "pure"
     ;; F2003. asynchronous separate.
335
     "abstract" "deferred" "import" "final" "non_intrinsic" "non_overridable"
336 337
     "nopass" "pass" "protected" "value" "volatile"
     ) 'words)
338
  "Keyword-regexp for font-lock level >= 3.")
Karl Heuer's avatar
Karl Heuer committed
339 340

(defconst f90-procedures-re
341
  (concat "\\<"
Glenn Morris's avatar
Glenn Morris committed
342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362
          (regexp-opt
           '("abs" "achar" "acos" "adjustl" "adjustr" "aimag" "aint"
             "all" "allocated" "anint" "any" "asin" "associated"
             "atan" "atan2" "bit_size" "btest" "ceiling" "char" "cmplx"
             "conjg" "cos" "cosh" "count" "cshift" "date_and_time" "dble"
             "digits" "dim" "dot_product" "dprod" "eoshift" "epsilon"
             "exp" "exponent" "floor" "fraction" "huge" "iachar" "iand"
             "ibclr" "ibits" "ibset" "ichar" "ieor" "index" "int" "ior"
             "ishft" "ishftc" "kind" "lbound" "len" "len_trim" "lge" "lgt"
             "lle" "llt" "log" "log10" "logical" "matmul" "max"
             "maxexponent" "maxloc" "maxval" "merge" "min" "minexponent"
             "minloc" "minval" "mod" "modulo" "mvbits" "nearest" "nint"
             "not" "pack" "precision" "present" "product" "radix"
             ;; Real is taken out here to avoid highlighting declarations.
             "random_number" "random_seed" "range" ;; "real"
             "repeat" "reshape" "rrspacing" "scale" "scan"
             "selected_int_kind" "selected_real_kind" "set_exponent"
             "shape" "sign" "sin" "sinh" "size" "spacing" "spread" "sqrt"
             "sum" "system_clock" "tan" "tanh" "tiny" "transfer"
             "transpose" "trim" "ubound" "unpack" "verify"
             ;; F95 intrinsic functions.
363 364 365 366 367 368 369 370 371 372 373 374 375
             "null" "cpu_time"
             ;; F2003.
             "move_alloc" "command_argument_count" "get_command"
             "get_command_argument" "get_environment_variable"
             "selected_char_kind" "wait" "flush" "new_line"
             "extends" "extends_type_of" "same_type_as" "bind"
             ;; F2003 ieee_arithmetic intrinsic module.
             "ieee_support_underflow_control" "ieee_get_underflow_mode"
             "ieee_set_underflow_mode"
             ;; F2003 iso_c_binding intrinsic module.
             "c_loc" "c_funloc" "c_associated" "c_f_pointer"
             "c_f_procpointer"
             ) t)
Glenn Morris's avatar
Glenn Morris committed
376 377
          ;; A left parenthesis to avoid highlighting non-procedures.
          "[ \t]*(")
Karl Heuer's avatar
Karl Heuer committed
378 379 380
  "Regexp whose first part matches F90 intrinsic procedures.")

(defconst f90-operators-re
Glenn Morris's avatar
Glenn Morris committed
381 382 383 384
  (concat "\\."
          (regexp-opt '("and" "eq" "eqv" "false" "ge" "gt" "le" "lt" "ne"
                        "neqv" "not" "or" "true") t)
          "\\.")
Karl Heuer's avatar
Karl Heuer committed
385 386 387
  "Regexp matching intrinsic operators.")

(defconst f90-hpf-keywords-re
388
  (regexp-opt
389
   ;; Intrinsic procedures.
390 391 392 393 394 395 396 397 398 399 400 401 402
   '("all_prefix" "all_scatter" "all_suffix" "any_prefix"
     "any_scatter" "any_suffix" "copy_prefix" "copy_scatter"
     "copy_suffix" "count_prefix" "count_scatter" "count_suffix"
     "grade_down" "grade_up"
     "hpf_alignment" "hpf_distribution" "hpf_template" "iall" "iall_prefix"
     "iall_scatter" "iall_suffix" "iany" "iany_prefix" "iany_scatter"
     "iany_suffix" "ilen" "iparity" "iparity_prefix"
     "iparity_scatter" "iparity_suffix" "leadz" "maxval_prefix"
     "maxval_scatter" "maxval_suffix" "minval_prefix" "minval_scatter"
     "minval_suffix" "number_of_processors" "parity"
     "parity_prefix" "parity_scatter" "parity_suffix" "popcnt" "poppar"
     "processors_shape" "product_prefix" "product_scatter"
     "product_suffix" "sum_prefix" "sum_scatter" "sum_suffix"
403
     ;; Directives.
404
     "align" "distribute" "dynamic" "independent" "inherit" "processors"
Glenn Morris's avatar
Glenn Morris committed
405
     "realign" "redistribute" "template"
406
     ;; Keywords.
407
     "block" "cyclic" "extrinsic" "new" "onto" "pure" "with") 'words)
Karl Heuer's avatar
Karl Heuer committed
408
  "Regexp for all HPF keywords, procedures and directives.")
Richard M. Stallman's avatar
Richard M. Stallman committed
409

410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433
(defconst f90-constants-re
  (regexp-opt '( ;; F2003 iso_fortran_env constants.
                "iso_fortran_env"
                "input_unit" "output_unit" "error_unit"
                "iostat_end" "iostat_eor"
                "numeric_storage_size" "character_storage_size"
                "file_storage_size"
                ;; F2003 iso_c_binding constants.
                "iso_c_binding"
                "c_int" "c_short" "c_long" "c_long_long" "c_signed_char"
                "c_size_t"
                "c_int8_t" "c_int16_t" "c_int32_t" "c_int64_t"
                "c_int_least8_t" "c_int_least16_t" "c_int_least32_t"
                "c_int_least64_t"
                "c_int_fast8_t" "c_int_fast16_t" "c_int_fast32_t"
                "c_int_fast64_t"
                "c_intmax_t" "c_intptr_t"
                "c_float" "c_double" "c_long_double"
                "c_float_complex" "c_double_complex" "c_long_double_complex"
                "c_bool" "c_char"
                "c_null_char" "c_alert" "c_backspace" "c_form_feed"
                "c_new_line" "c_carriage_return" "c_horizontal_tab"
                "c_vertical_tab"
                "c_ptr" "c_funptr" "c_null_ptr" "c_null_funptr"
434 435 436
                "ieee_exceptions"
                "ieee_arithmetic"
                "ieee_features"
437 438
                ) 'words)
  "Regexp for Fortran intrinsic constants.")
Richard M. Stallman's avatar
Richard M. Stallman committed
439

440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463
;; cf f90-looking-at-type-like.
(defun f90-typedef-matcher (limit)
  "Search for the start/end of the definition of a derived type, up to LIMIT.
Set the match data so that subexpression 1,2 are the TYPE, and
type-name parts, respectively."
  (let (found l)
    (while (and (re-search-forward "\\<\\(\\(?:end[ \t]*\\)?type\\)[ \t]*"
                                   limit t)
                (not (setq found
                           (progn
                             (setq l (match-data))
                             (unless (looking-at "\\(is\\>\\|(\\)")
                               (when (if (looking-at "\\(\\sw+\\)")
                                         (goto-char (match-end 0))
                                       (re-search-forward
                                        "[ \t]*::[ \t]*\\(\\sw+\\)"
                                        (line-end-position) t))
                                 ;; 0 is wrong, but we don't use it.
                                 (set-match-data
                                  (append l (list (match-beginning 1)
                                                  (match-end 1))))
                                 t)))))))
    found))

Karl Heuer's avatar
Karl Heuer committed
464
(defvar f90-font-lock-keywords-1
Dave Love's avatar
Dave Love committed
465
  (list
466
   ;; Special highlighting of "module procedure".
467 468
   '("\\<\\(module[ \t]*procedure\\)\\>\\([^()\n]*::\\)?[ \t]*\\([^&!\n]*\\)"
     (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
469
   ;; Highlight definition of derived type.
470 471 472 473
;;;    '("\\<\\(\\(?:end[ \t]*\\)?type\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
;;;      (1 font-lock-keyword-face) (3 font-lock-function-name-face))
   '(f90-typedef-matcher
     (1 font-lock-keyword-face) (2 font-lock-function-name-face))
474
   ;; Other functions and declarations.
475
   '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|associate\\|\
476
subroutine\\)\\|use\\|call\\)\\>[ \t]*\\(\\sw+\\)?"
477
     (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
478 479 480 481 482 483 484 485 486 487 488 489
   ;; F2003.
   '("\\<\\(use\\)[ \t]*,[ \t]*\\(\\(?:non_\\)?intrinsic\\)[ \t]*::[ \t]*\
\\(\\sw+\\)"
     (1 font-lock-keyword-face) (2 font-lock-keyword-face)
     (3 font-lock-function-name-face))
   "\\<\\(\\(end[ \t]*\\)?block[ \t]*data\\|contains\\|\
end[ \t]*interface\\)\\>"
   ;; "abstract interface" is F2003. Must come after previous entry.
   '("\\<\\(\\(?:abstract[ \t]*\\)?interface\\)\\>"
     ;; [ \t]*\\(\\(\\sw+\\)[ \t]*[^(]\\)?"
     ;; (2) messes up "interface operator ()", etc.
     (1 font-lock-keyword-face))) ;(2 font-lock-function-name-face nil t)))
Karl Heuer's avatar
Karl Heuer committed
490 491
  "This does fairly subdued highlighting of comments and function calls.")

492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528
;; NB not explicitly handling this, yet it seems to work.
;; type(...) function foo()
(defun f90-typedec-matcher (limit)
  "Search for the declaration of variables of derived type, up to LIMIT.
Set the match data so that subexpression 1,2 are the TYPE(...),
and variable-name parts, respectively."
  ;; Matcher functions must return nil only when there are no more
  ;; matches within the search range.
  (let (found l)
    (while (and (re-search-forward "\\<\\(type\\|class\\)[ \t]*(" limit t)
                (not
                 (setq found
                       (condition-case nil
                           (progn
                             ;; Set l after this to just highlight
                             ;; the "type" part.
                             (backward-char 1)
                             ;; Needed for: type( foo(...) ) :: bar
                             (forward-sexp)
                             (setq l (list (match-beginning 0) (point)))
                             (skip-chars-forward " \t")
                             (when
                                 (re-search-forward
                                  ;; type (foo) bar, qux
                                  (if (looking-at "\\sw+")
                                      "\\([^&!\n]+\\)"
                                    ;; type (foo), stuff :: bar, qux
                                    "::[ \t]*\\([^&!\n]+\\)")
                                  (line-end-position) t)
                               (set-match-data
                                (append (list (car l) (match-end 1))
                                        l (list (match-beginning 1)
                                                (match-end 1))))
                               t))
                         (error nil))))))
    found))

Karl Heuer's avatar
Karl Heuer committed
529
(defvar f90-font-lock-keywords-2
Glenn Morris's avatar
Glenn Morris committed
530 531 532
  (append
   f90-font-lock-keywords-1
   (list
533
    ;; Variable declarations (avoid the real function call).
534 535 536 537 538 539 540 541 542 543
    ;; NB by accident (?), this correctly fontifies the "integer" in:
    ;; integer () function foo ()
    ;; because "() function foo ()" matches \\3.
    ;; The "pure" part does not really belong here, but was added to
    ;; exploit that hack.
    ;; The "function foo" bit is correctly fontified by keywords-1.
    ;; TODO ? actually check for balanced parens in that case.
    '("^[ \t0-9]*\\(?:pure\\|elemental\\)?[ \t]*\
\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\
enumerator\\|generic\\|procedure\\|logical\\|double[ \t]*precision\\)\
544
\\(.*::\\|[ \t]*(.*)\\)?\\([^&!\n]*\\)"
545
      (1 font-lock-type-face t) (4 font-lock-variable-name-face t))
546 547 548 549 550 551
    ;; Derived type/class variables.
    ;; TODO ? If we just highlighted the "type" part, rather than
    ;; "type(...)", this could be in the previous expression. And this
    ;; would be consistent with integer( kind=8 ), etc.
    '(f90-typedec-matcher
      (1 font-lock-type-face) (2 font-lock-variable-name-face))
552 553 554
    ;; "real function foo (args)". Must override previous.  Note hack
    ;; to get "args" unhighlighted again. Might not always be right,
    ;; but probably better than leaving them as variables.
555
    ;; NB not explicitly handling this case:
556
    ;; integer( kind=1 ) function foo()
557 558
    ;; thanks to the happy accident described above.
    ;; Not anchored, so don't need to worry about "pure" etc.
559 560 561 562 563 564
    '("\\<\\(\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\
logical\\|double[ \t]*precision\\|\
\\(?:type\\|class\\)[ \t]*([ \t]*\\sw+[ \t]*)\\)[ \t]*\\)\
\\(function\\)\\>[ \t]*\\(\\sw+\\)[ \t]*\\(([^&!\n]*)\\)"
      (1 font-lock-type-face t) (4 font-lock-keyword-face t)
      (5 font-lock-function-name-face t) (6 'default t))
565 566 567 568
    ;; enum (F2003; cf type in -1).
    '("\\<\\(enum\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
      (1 font-lock-keyword-face) (3 font-lock-function-name-face))
    ;; end do, enum (F2003), if, select, where, and forall constructs.
569
    '("\\<\\(end[ \t]*\\(do\\|if\\|enum\\|select\\|forall\\|where\\)\\)\\>\
Glenn Morris's avatar
Glenn Morris committed
570 571
\\([ \t]+\\(\\sw+\\)\\)?"
      (1 font-lock-keyword-face) (3 font-lock-constant-face nil t))
572
    '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\
573 574
do\\([ \t]*while\\)?\\|select[ \t]*\\(?:case\\|type\\)\\|where\\|\
forall\\)\\)\\>"
Glenn Morris's avatar
Glenn Morris committed
575
      (2 font-lock-constant-face nil t) (3 font-lock-keyword-face))
576
    ;; Implicit declaration.
Glenn Morris's avatar
Glenn Morris committed
577
    '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\
578 579
\\|enumerator\\|procedure\\|\
logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*"
Glenn Morris's avatar
Glenn Morris committed
580 581 582 583
      (1 font-lock-keyword-face) (2 font-lock-type-face))
    '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/"
      (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
    "\\<else\\([ \t]*if\\|where\\)?\\>"
584
    '("\\(&\\)[ \t]*\\(!\\|$\\)"  (1 font-lock-keyword-face))
Glenn Morris's avatar
Glenn Morris committed
585 586 587 588
    "\\<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\>"
    '("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>"
      (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
    '("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1)
589 590 591 592 593
    ;; F2003 "class default".
    '("\\<\\(class\\)[ \t]*default" . 1)
    ;; F2003 "type is" in a "select type" block.
    '("\\<\\(\\(type\\|class\\)[ \t]*is\\)[ \t]*(" (1 font-lock-keyword-face t))
    '("\\<\\(do\\|go[ \t]*to\\)\\>[ \t]*\\([0-9]+\\)"
Glenn Morris's avatar
Glenn Morris committed
594
      (1 font-lock-keyword-face) (2 font-lock-constant-face))
595
    ;; Line numbers (lines whose first character after number is letter).
Glenn Morris's avatar
Glenn Morris committed
596
    '("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t))))
597
  "Highlights declarations, do-loops and other constructs.")
Karl Heuer's avatar
Karl Heuer committed
598 599 600

(defvar f90-font-lock-keywords-3
  (append f90-font-lock-keywords-2
Glenn Morris's avatar
Glenn Morris committed
601 602 603 604
          (list
           f90-keywords-level-3-re
           f90-operators-re
           (list f90-procedures-re '(1 font-lock-keyword-face keep))
Glenn Morris's avatar
Glenn Morris committed
605
           "\\<real\\>"                 ; avoid overwriting real defs
606 607
           ;; As an attribute, but not as an optional argument.
           '("\\<\\(asynchronous\\)[ \t]*[^=]" . 1)
Glenn Morris's avatar
Glenn Morris committed
608
           ))
Karl Heuer's avatar
Karl Heuer committed
609 610 611 612
  "Highlights all F90 keywords and intrinsic procedures.")

(defvar f90-font-lock-keywords-4
  (append f90-font-lock-keywords-3
613 614 615
          (list (cons f90-constants-re 'font-lock-constant-face)
                f90-hpf-keywords-re))
  "Highlights all F90 and HPF keywords and constants.")
Karl Heuer's avatar
Karl Heuer committed
616 617

(defvar f90-font-lock-keywords
618
  f90-font-lock-keywords-2
619 620
  "*Default expressions to highlight in F90 mode.
Can be overridden by the value of `font-lock-maximum-decoration'.")
Richard M. Stallman's avatar
Richard M. Stallman committed
621

622

623 624 625 626 627 628 629 630 631 632 633 634 635 636
(defvar f90-mode-syntax-table
  (let ((table (make-syntax-table)))
    (modify-syntax-entry ?\! "<"  table) ; begin comment
    (modify-syntax-entry ?\n ">"  table) ; end comment
    (modify-syntax-entry ?_  "w"  table) ; underscore in names
    (modify-syntax-entry ?\' "\"" table) ; string quote
    (modify-syntax-entry ?\" "\"" table) ; string quote
    (modify-syntax-entry ?\` "w"  table) ; for abbrevs
    (modify-syntax-entry ?\r " "  table) ; return is whitespace
    (modify-syntax-entry ?+  "."  table) ; punctuation
    (modify-syntax-entry ?-  "."  table)
    (modify-syntax-entry ?=  "."  table)
    (modify-syntax-entry ?*  "."  table)
    (modify-syntax-entry ?/  "."  table)
637 638 639
    ;; I think that the f95 standard leaves the behaviour of \
    ;; unspecified, but that f2k will require it to be non-special.
    ;; Use `f90-backslash-not-special' to change.
640 641 642 643 644 645 646 647 648 649 650
    (modify-syntax-entry ?\\ "\\" table) ; escape chars
    table)
  "Syntax table used in F90 mode.")

(defvar f90-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "`"        'f90-abbrev-start)
    (define-key map "\C-c;"    'f90-comment-region)
    (define-key map "\C-\M-a"  'f90-beginning-of-subprogram)
    (define-key map "\C-\M-e"  'f90-end-of-subprogram)
    (define-key map "\C-\M-h"  'f90-mark-subprogram)
651 652
    (define-key map "\C-\M-n"  'f90-end-of-block)
    (define-key map "\C-\M-p"  'f90-beginning-of-block)
653 654 655 656 657
    (define-key map "\C-\M-q"  'f90-indent-subprogram)
    (define-key map "\C-j"     'f90-indent-new-line) ; LFD equals C-j
    (define-key map "\r"       'newline)
    (define-key map "\C-c\r"   'f90-break-line)
;;;  (define-key map [M-return] 'f90-break-line)
658 659
    (define-key map "\C-c\C-a" 'f90-previous-block)
    (define-key map "\C-c\C-e" 'f90-next-block)
660 661 662 663 664 665 666 667 668 669 670
    (define-key map "\C-c\C-d" 'f90-join-lines)
    (define-key map "\C-c\C-f" 'f90-fill-region)
    (define-key map "\C-c\C-p" 'f90-previous-statement)
    (define-key map "\C-c\C-n" 'f90-next-statement)
    (define-key map "\C-c\C-w" 'f90-insert-end)
    (define-key map "\t"       'f90-indent-line)
    (define-key map ","        'f90-electric-insert)
    (define-key map "+"        'f90-electric-insert)
    (define-key map "-"        'f90-electric-insert)
    (define-key map "*"        'f90-electric-insert)
    (define-key map "/"        'f90-electric-insert)
671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724

    (easy-menu-define f90-menu map "Menu for F90 mode."
      `("F90"
        ("Customization"
         ,(custom-menu-create 'f90)
         ["Set"  Custom-set t]
         ["Save" Custom-save t]
         ["Reset to Current" Custom-reset-current t]
         ["Reset to Saved"   Custom-reset-saved t]
         ["Reset to Standard Settings" Custom-reset-standard t]
         )
        "--"
        ["Indent Subprogram"       f90-indent-subprogram       t]
        ["Mark Subprogram"         f90-mark-subprogram         t]
        ["Beginning of Subprogram" f90-beginning-of-subprogram t]
        ["End of Subprogram"       f90-end-of-subprogram       t]
        "--"
        ["(Un)Comment Region" f90-comment-region mark-active]
        ["Indent Region"      f90-indent-region  mark-active]
        ["Fill Region"        f90-fill-region    mark-active]
        "--"
        ["Break Line at Point"     f90-break-line t]
        ["Join with Previous Line" f90-join-lines t]
        ["Insert Block End"        f90-insert-end t]
        "--"
        ("Highlighting"
         ["Toggle font-lock-mode" font-lock-mode :selected font-lock-mode
          :style toggle]
         "--"
         ["Light highlighting (level 1)"    f90-font-lock-1 t]
         ["Moderate highlighting (level 2)" f90-font-lock-2 t]
         ["Heavy highlighting (level 3)"    f90-font-lock-3 t]
         ["Maximum highlighting (level 4)"  f90-font-lock-4 t]
         )
        ("Change Keyword Case"
         ["Upcase Keywords (buffer)"     f90-upcase-keywords     t]
         ["Capitalize Keywords (buffer)" f90-capitalize-keywords t]
         ["Downcase Keywords (buffer)"   f90-downcase-keywords   t]
         "--"
         ["Upcase Keywords (region)"     f90-upcase-region-keywords
          mark-active]
         ["Capitalize Keywords (region)" f90-capitalize-region-keywords
          mark-active]
         ["Downcase Keywords (region)"   f90-downcase-region-keywords
          mark-active]
         )
        "--"
        ["Toggle auto-fill"   auto-fill-mode :selected auto-fill-function
         :style toggle]
        ["Toggle abbrev-mode" abbrev-mode    :selected abbrev-mode
         :style toggle]
        ["Add imenu Menu" f90-add-imenu-menu
         :active   (not (lookup-key (current-local-map) [menu-bar index]))
         :included (fboundp 'imenu-add-to-menubar)]))
725
    map)
Richard M. Stallman's avatar
Richard M. Stallman committed
726
  "Keymap used in F90 mode.")
Karl Heuer's avatar
Karl Heuer committed
727

728

729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757
(defun f90-font-lock-1 ()
  "Set `font-lock-keywords' to `f90-font-lock-keywords-1'."
  (interactive)
  (font-lock-mode 1)
  (setq font-lock-keywords f90-font-lock-keywords-1)
  (font-lock-fontify-buffer))

(defun f90-font-lock-2 ()
  "Set `font-lock-keywords' to `f90-font-lock-keywords-2'."
  (interactive)
  (font-lock-mode 1)
  (setq font-lock-keywords f90-font-lock-keywords-2)
  (font-lock-fontify-buffer))

(defun f90-font-lock-3 ()
  "Set `font-lock-keywords' to `f90-font-lock-keywords-3'."
  (interactive)
  (font-lock-mode 1)
  (setq font-lock-keywords f90-font-lock-keywords-3)
  (font-lock-fontify-buffer))

(defun f90-font-lock-4 ()
  "Set `font-lock-keywords' to `f90-font-lock-keywords-4'."
  (interactive)
  (font-lock-mode 1)
  (setq font-lock-keywords f90-font-lock-keywords-4)
  (font-lock-fontify-buffer))


Karl Heuer's avatar
Karl Heuer committed
758
;; Regexps for finding program structures.
Glenn Morris's avatar
Glenn Morris committed
759
(defconst f90-blocks-re
760 761
  (concat "\\(block[ \t]*data\\|"
          (regexp-opt '("do" "if" "interface" "function" "module" "program"
762 763 764
                        "select" "subroutine" "type" "where" "forall"
                        ;; F2003.
                        "enum" "associate"))
765 766 767
          "\\)\\>")
  "Regexp potentially indicating a \"block\" of F90 code.")

Glenn Morris's avatar
Glenn Morris committed
768
(defconst f90-program-block-re
769 770 771
  (regexp-opt '("program" "module" "subroutine" "function") 'paren)
  "Regexp used to locate the start/end of a \"subprogram\".")

772
;; "class is" is F2003.
Glenn Morris's avatar
Glenn Morris committed
773
(defconst f90-else-like-re
774 775 776
  "\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\|\
\\(class\\|type\\)[ \t]*is[ \t]*(\\|class[ \t]*default\\)"
  "Regexp matching an ELSE IF, ELSEWHERE, CASE, CLASS/TYPE IS statement.")
777

Glenn Morris's avatar
Glenn Morris committed
778
(defconst f90-end-if-re
779 780 781 782 783
  (concat "end[ \t]*"
          (regexp-opt '("if" "select" "where" "forall") 'paren)
          "\\>")
  "Regexp matching the end of an IF, SELECT, WHERE, FORALL block.")

Glenn Morris's avatar
Glenn Morris committed
784
(defconst f90-end-type-re
785 786 787 788 789 790
  "end[ \t]*\\(type\\|enum\\|interface\\|block[ \t]*data\\)\\>"
  "Regexp matching the end of a TYPE, ENUM, INTERFACE, BLOCK DATA section.")

(defconst f90-end-associate-re
  "end[ \t]*associate\\>"
  "Regexp matching the end of an ASSOCIATE block.")
791

792 793
;; This is for a TYPE block, not a variable of derived TYPE.
;; Hence no need to add CLASS for F2003.
Karl Heuer's avatar
Karl Heuer committed
794
(defconst f90-type-def-re
795 796 797 798
  ;; type word
  ;; type :: word
  ;; type, stuff :: word
  ;; NOT "type ("
799
  "\\<\\(type\\)\\>\\(?:[^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
Glenn Morris's avatar
Glenn Morris committed
800
  "Regexp matching the definition of a derived type.")
801

802 803 804 805
(defconst f90-typeis-re
  "\\<\\(class\\|type\\)[ \t]*is[ \t]*("
  "Regexp matching a CLASS/TYPE IS statement.")

806
(defconst f90-no-break-re
807 808 809 810 811 812
  (regexp-opt '("**" "//" "=>" ">=" "<=" "==" "/=") 'paren)
  "Regexp specifying where not to break lines when filling.
This regexp matches certain tokens comprised entirely of
characters matching the regexp `f90-break-delimiters' that should
not be split by filling.  Each element is assumed to be two
characters long.")
813 814 815

(defvar f90-cache-position nil
  "Temporary position used to speed up region operations.")
Richard M. Stallman's avatar
Richard M. Stallman committed
816
(make-variable-buffer-local 'f90-cache-position)
817

818 819 820

;; Hideshow support.
(defconst f90-end-block-re
821
  (concat "^[ \t0-9]*\\<end[ \t]*"
822
          (regexp-opt '("do" "if" "forall" "function" "interface"
823
                        "module" "program" "select" "subroutine"
824 825
                        "type" "where" "enum" "associate") t)
          "\\>")
826
  "Regexp matching the end of an F90 \"block\", from the line start.
827 828 829
Used in the F90 entry in `hs-special-modes-alist'.")

;; Ignore the fact that FUNCTION, SUBROUTINE, WHERE, FORALL have a
830
;; following "(".  DO, CASE, IF can have labels.
831 832 833 834 835
(defconst f90-start-block-re
  (concat
   "^[ \t0-9]*"                         ; statement number
   "\\(\\("
   "\\(\\sw+[ \t]*:[ \t]*\\)?"          ; structure label
836
   "\\(do\\|select[ \t]*\\(case\\|type\\)\\|"
837 838 839
   ;; See comments in fortran-start-block-re for the problems of IF.
   "if[ \t]*(\\(.*\\|"
   ".*\n\\([^if]*\\([^i].\\|.[^f]\\|.\\>\\)\\)\\)\\<then\\|"
840 841 842
   ;; Distinguish WHERE block from isolated WHERE.
   "\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)\\)\\)"
   "\\|"
843 844 845
   ;; Avoid F2003 "type is" in "select type",
   ;; and also variables of derived type "type (foo)".
   ;; "type, foo" must be a block (?).
846 847 848 849
   "type[ \t,]\\("
   "[^i(!\n\"\& \t]\\|"                 ; not-i(
   "i[^s!\n\"\& \t]\\|"                 ; i not-s
   "is\\sw\\)\\|"
850
   ;; "abstract interface" is F2003.
851
   "program\\|\\(?:abstract[ \t]*\\)?interface\\|module\\|"
852 853
   ;; "enum", but not "enumerator".
   "function\\|subroutine\\|enum[^e]\\|associate"
854 855
   "\\)"
   "[ \t]*")
856
  "Regexp matching the start of an F90 \"block\", from the line start.
857 858 859 860 861 862 863 864 865
A simple regexp cannot do this in fully correct fashion, so this
tries to strike a compromise between complexity and flexibility.
Used in the F90 entry in `hs-special-modes-alist'.")

;; hs-special-modes-alist is autoloaded.
(add-to-list 'hs-special-modes-alist
             `(f90-mode ,f90-start-block-re ,f90-end-block-re
                        "!" f90-end-of-block nil))

866

867
;; Imenu support.
868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883
;; FIXME trivial to extend this to enum. Worth it?
(defun f90-imenu-type-matcher ()
  "Search backward for the start of a derived type.
Set subexpression 1 in the match-data to the name of the type."
  (let (found l)
    (while (and (re-search-backward "^[ \t0-9]*type[ \t]*" nil t)
                (not (setq found
                           (save-excursion
                             (goto-char (match-end 0))
                             (unless (looking-at "\\(is\\>\\|(\\)")
                               (or (looking-at "\\(\\sw+\\)")
                                   (re-search-forward
                                    "[ \t]*::[ \t]*\\(\\sw+\\)"
                                    (line-end-position) t))))))))
    found))

Karl Heuer's avatar
Karl Heuer committed
884
(defvar f90-imenu-generic-expression
885
  (let ((good-char "[^!\"\&\n \t]") (not-e "[^e!\n\"\& \t]")
886 887
        (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]")
        (not-ib "[^i(!\n\"\& \t]") (not-s "[^s!\n\"\& \t]"))
888 889 890
    (list
     '(nil "^[ \t0-9]*program[ \t]+\\(\\sw+\\)" 1)
     '("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1)
891 892 893 894 895 896 897 898
     (list "Types" 'f90-imenu-type-matcher 1)
     ;; Does not handle: "type[, stuff] :: foo".
;;;      (format "^[ \t0-9]*type[ \t]+\\(\\(%s\\|i%s\\|is\\sw\\)\\sw*\\)"
;;;              not-ib not-s)
;;;      1)
     ;; Can't get the subexpression numbers to match in the two branches.
;;;      (format "^[ \t0-9]*type\\([ \t]*,.*\\(::\\)[ \t]*\\(\\sw+\\)\\|[ \t]+\\(\\(%s\\|i%s\\|is\\sw\\)\\sw*\\)\\)" not-ib not-s)
;;;      3)
899
     (list
Glenn Morris's avatar
Glenn Morris committed
900
      "Procedures"
901 902 903
      (concat
       "^[ \t0-9]*"
       "\\("
904 905
       ;; At least three non-space characters before function/subroutine.
       ;; Check that the last three non-space characters do not spell E N D.
906 907 908 909 910
       "[^!\"\&\n]*\\("
       not-e good-char good-char "\\|"
       good-char not-n good-char "\\|"
       good-char good-char not-d "\\)"
       "\\|"
911
       ;; Less than three non-space characters before function/subroutine.
912 913 914
       good-char "?" good-char "?"
       "\\)"
       "[ \t]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)")
Glenn Morris's avatar
Glenn Morris committed
915
      4)))
916
  "Value for `imenu-generic-expression' in F90 mode.")
Karl Heuer's avatar
Karl Heuer committed
917

918 919
(defun f90-add-imenu-menu ()
  "Add an imenu menu to the menubar."
920
  (interactive)
921
  (if (lookup-key (current-local-map) [menu-bar index])
922 923
      (message "%s" "F90-imenu already exists.")
    (imenu-add-to-menubar "F90-imenu")
924
    (redraw-frame (selected-frame))))
925

Richard M. Stallman's avatar
Richard M. Stallman committed
926

927
;; Abbrevs have generally two letters, except standard types `c, `i, `r, `t.
928
(defvar f90-mode-abbrev-table
929
  (progn
930
    (define-abbrev-table 'f90-mode-abbrev-table nil)
931 932
    f90-mode-abbrev-table)
  "Abbrev table for F90 mode.")
933

934 935 936
(let (abbrevs-changed)
  ;; Use the 6th arg (SYSTEM-FLAG) of define-abbrev if possible.
  ;; A little baroque to quieten the byte-compiler.
937
  (mapc
938 939 940 941 942 943 944 945 946
   (function (lambda (element)
               (condition-case nil
                   (apply 'define-abbrev f90-mode-abbrev-table
                          (append element '(nil 0 t)))
                 (wrong-number-of-arguments
                  (apply 'define-abbrev f90-mode-abbrev-table
                         (append element '(nil 0)))))))
   '(("`al"  "allocate"     )
     ("`ab"  "allocatable"  )
947
     ("`ai"  "abstract interface")
948
     ("`as"  "assignment"   )
949
     ("`asy" "asynchronous" )