lisp/progmodes/f90.el

   1 ;;; f90.el --- Fortran-90 mode (free format)
   2
   3 ;; Copyright (C) 1995, 1996, 1997, 2000 Free Software Foundation, Inc.
   4
   5 ;; Author: Torbj\"orn Einarsson <Torbjorn.Einarsson@era.ericsson.se>
   6 ;; Maintainer: Dave Love <fx@gnu.org>
   7 ;; Keywords: fortran, f90, languages
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; Smart mode for editing F90 programs in FREE FORMAT.
  29 ;; Knows about continuation lines, named structured statements, and other
  30 ;; new features in F90 including HPF (High Performance Fortran) structures.
  31 ;; The basic feature is to provide an accurate indentation of F90 programs.
  32 ;; In addition, there are many more features like automatic matching of all
  33 ;; end statements, an auto-fill function to break long lines, a join-lines
  34 ;; function which joins continued lines etc etc.
  35 ;;  To facilitate typing, a fairly complete list of abbreviations is provided.
  36 ;;    For example, `i is short-hand for integer (if abbrev-mode is on).
  37
  38 ;; There are two separate features for highlighting the code.
  39 ;;   1) Upcasing or capitalizing of all keywords.
  40 ;;   2) Colors/fonts using font-lock-mode. (only when using X-windows)
  41 ;;  Automatic upcase of downcase of keywords is controlled by the parameter
  42 ;;  f90-auto-keyword-case.
  43
  44 ;; The indentations of lines starting with ! is determined by the first of the
  45 ;; following matches (the values in the left column are the default values):
  46
  47 ;; start-string/regexp  indent         variable holding start-string/regexp
  48 ;;    !!!                  0
  49 ;;    !hpf\\$ (re)         0              f90-directive-comment-re
  50 ;;    !!$                  0              f90-comment-region
  51 ;;    !      (re)        as code          f90-indented-comment-re
  52 ;;    default            comment-column
  53
  54 ;; Ex: Here is the result of 3 different settings of f90-indented-comment-re
  55 ;;     f90-indented-comment-re  !-indentation      !!-indentation
  56 ;;          !                    as code             as code
  57 ;;          !!                   comment-column      as code
  58 ;;          ![^!]                as code             comment-column
  59 ;; Trailing comments are indented to comment-column with indent-for-comment M-;
  60 ;; f90-comment-region (C-c;) toggles insertion of f90-comment-region in region.
  61
  62 ;; One common convention for free vs. fixed format is that free-format files
  63 ;; have the ending .f90 while the fixed format files have the ending .f.
  64 ;; To make f90-mode work, put this file in, for example, your directory
  65 ;;  ~/lisp, and be sure that you have the following in your .emacs-file
  66 ;;     (setq load-path (append load-path '("~/lisp")))
  67 ;;     (autoload 'f90-mode "f90"
  68 ;;       "Major mode for editing Fortran 90 code in free format." t)
  69 ;;     (setq auto-mode-alist (append auto-mode-alist
  70 ;;                           (list '("\\.f90$" . f90-mode))))
  71 ;; Once you have entered f90-mode, you may get more info by using
  72 ;; the command describe-mode (C-h m). For online help describing various
  73 ;; functions use  C-h f <Name of function you want described>
  74
  75 ;; To customize the f90-mode for your taste, use, for example:
  76 ;;    (you don't have to specify values for all the parameters below)
  77 ;;(add-hook 'f90-mode-hook
  78 ;;      '(lambda () (setq f90-do-indent 3
  79 ;;                        f90-if-indent 3
  80 ;;                        f90-type-indent 3
  81 ;;                        f90-program-indent 2
  82 ;;                        f90-continuation-indent 5
  83 ;;                        f90-comment-region "!!$"
  84 ;;                        f90-directive-comment-re "!hpf\\$"
  85 ;;                        f90-indented-comment-re "!"
  86 ;;                        f90-break-delimiters "[-+\\*/,><=% \t]"
  87 ;;                        f90-break-before-delimiters t
  88 ;;                        f90-beginning-ampersand t
  89 ;;                        f90-smart-end 'blink
  90 ;;                        f90-auto-keyword-case nil
  91 ;;                        f90-leave-line-no  nil
  92 ;;                        f90-startup-message t
  93 ;;                        indent-tabs-mode nil
  94 ;;                        f90-font-lock-keywords f90-font-lock-keywords-2
  95 ;;                  )
  96 ;;       ;;The rest is not default.
  97 ;;       (abbrev-mode 1)             ; turn on abbreviation mode
  98 ;;       (f90-add-imenu-menu)        ; extra menu with functions etc.
  99 ;;       (if f90-auto-keyword-case   ; change case of all keywords on startup
 100 ;;           (f90-change-keywords f90-auto-keyword-case))
 101 ;;       ))
 102 ;; in your .emacs file (the shown values are the defaults). You can also
 103 ;; change the values of the lists f90-keywords etc.
 104 ;; The auto-fill and abbreviation minor modes are accessible from the menu,
 105 ;; or by using M-x auto-fill-mode and M-x abbrev-mode, respectively.
 106
 107 ;; Remarks
 108 ;; 1) Line numbers are by default left-justified. If f90-leave-line-no is
 109 ;;    non-nil, the line numbers are never touched.
 110 ;; 2) Multi-; statements like > do i=1,20 ; j=j+i ; end do < are not handled
 111 ;;    correctly, but I imagine them to be rare.
 112 ;; 3) Regexps for hilit19 are no longer supported.
 113 ;; 4) For FIXED FORMAT code, use the ordinary fortran mode.
 114 ;; 5) This mode does not work under emacs-18.x.
 115 ;; 6) Preprocessor directives, i.e., lines starting with # are left-justified
 116 ;;    and are untouched by all case-changing commands. There is, at present, no
 117 ;;    mechanism for treating multi-line directives (continued by \ ).
 118 ;; 7) f77 do-loops do 10 i=.. ; ; 10 continue are not correctly indented.
 119 ;;    You are urged to use f90-do loops (with labels if you wish).
 120 ;; 8) The highlighting mode under XEmacs is not as complete as under Emacs.
 121
 122 ;; List of user commands
 123 ;;   f90-previous-statement         f90-next-statement
 124 ;;   f90-beginning-of-subprogram    f90-end-of-subprogram   f90-mark-subprogram
 125 ;;   f90-comment-region
 126 ;;   f90-indent-line                f90-indent-new-line
 127 ;;   f90-indent-region    (can be called by calling indent-region)
 128 ;;   f90-indent-subprogram
 129 ;;   f90-break-line                 f90-join-lines
 130 ;;   f90-fill-region
 131 ;;   f90-insert-end
 132 ;;   f90-upcase-keywords            f90-upcase-region-keywords
 133 ;;   f90-downcase-keywords          f90-downcase-region-keywords
 134 ;;   f90-capitalize-keywords        f90-capitalize-region-keywords
 135 ;;   f90-add-imenu-menu
 136 ;;   f90-font-lock-1, f90-font-lock-2, f90-font-lock-3, f90-font-lock-4
 137
 138 ;; Thanks to all the people who have tested the mode. Special thanks to Jens
 139 ;; Bloch Helmers for encouraging me to write this code, for creative
 140 ;; suggestions as well as for the lists of hpf-commands.
 141 ;; Also thanks to the authors of the fortran and pascal modes, on which some
 142 ;; of this code is built.
 143
 144 ;;; Code:
 145
 146 (defconst bug-f90-mode "T.Einarsson@clab.ericsson.se"
 147   "Address of mailing list for F90 mode bugs.")
 148
 149 ;; User options
 150
 151 (defgroup f90 nil
 152   "Fortran-90 mode"
 153   :group 'languages)
 154
 155 (defgroup f90-indent nil
 156   "Fortran-90 indentation"
 157   :prefix "f90-"
 158   :group 'f90)
 159
 160
 161 (defcustom f90-do-indent 3
 162   "*Extra indentation applied to DO blocks."
 163   :type 'integer
 164   :group 'f90-indent)
 165
 166 (defcustom f90-if-indent 3
 167   "*Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks."
 168   :type 'integer
 169   :group 'f90-indent)
 170
 171 (defcustom f90-type-indent 3
 172   "*Extra indentation applied to TYPE, INTERFACE and BLOCK DATA blocks."
 173   :type 'integer
 174   :group 'f90-indent)
 175
 176 (defcustom f90-program-indent 2
 177   "*Extra indentation applied to PROGRAM/MODULE/SUBROUTINE/FUNCTION blocks."
 178   :type 'integer
 179   :group 'f90-indent)
 180
 181 (defcustom f90-continuation-indent 5
 182   "*Extra indentation applied to F90 continuation lines."
 183   :type 'integer
 184   :group 'f90-indent)
 185
 186 (defcustom f90-comment-region "!!$"
 187   "*String inserted by \\[f90-comment-region]\
 188  at start of each line in region."
 189   :type 'string
 190   :group 'f90-indent)
 191
 192 (defcustom f90-indented-comment-re "!"
 193   "*Regexp saying which comments to be indented like code."
 194   :type 'regexp
 195   :group 'f90-indent)
 196
 197 (defcustom f90-directive-comment-re "!hpf\\$"
 198   "*Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented."
 199   :type 'regexp
 200   :group 'f90-indent)
 201
 202 (defcustom f90-beginning-ampersand t
 203   "*t makes automatic insertion of \& at beginning of continuation line."
 204   :type 'boolean
 205   :group 'f90)
 206
 207 (defcustom f90-smart-end 'blink
 208   "*From an END statement, check and fill the end using matching block start.
 209 Allowed values are 'blink, 'no-blink, and nil, which determine
 210 whether to blink the matching beginning."
 211   :type '(choice (const blink) (const no-blink) (const nil))
 212   :group 'f90)
 213
 214 (defcustom f90-break-delimiters "[-+\\*/><=,% \t]"
 215   "*Regexp holding list of delimiters at which lines may be broken."
 216   :type 'regexp
 217   :group 'f90)
 218
 219 (defcustom f90-break-before-delimiters t
 220   "*Non-nil causes `f90-do-auto-fill' to break lines before delimiters."
 221   :type 'boolean
 222   :group 'f90)
 223
 224 (defcustom f90-auto-keyword-case nil
 225   "*Automatic case conversion of keywords.
 226   The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil"
 227   :type '(choice (const downcase-word) (const upcase-word)
 228                  (const capitalize-word) (const nil))
 229   :group 'f90)
 230
 231 (defcustom f90-leave-line-no nil
 232   "*If nil, left-justify linenumbers."
 233   :type 'boolean
 234   :group 'f90)
 235
 236 (defcustom f90-startup-message t
 237   "*Non-nil displays a startup message when F90 mode is first called."
 238   :type 'boolean
 239   :group 'f90)
 240
 241 (defconst f90-keywords-re
 242   ;;("allocate" "allocatable" "assign" "assignment" "backspace" "block"
 243   ;;"call" "case" "character" "close" "common" "complex" "contains"
 244   ;;"continue" "cycle" "data" "deallocate" "dimension" "do" "double" "else"
 245   ;;"elseif" "elsewhere" "end" "enddo" "endfile" "endif" "entry" "equivalence"
 246   ;;"exit" "external" "forall" "format" "function" "goto" "if" "implicit"
 247   ;;"include" "inquire" "integer" "intent" "interface" "intrinsic" "logical"
 248   ;;"module" "namelist" "none" "nullify" "only" "open" "operator" "optional" "parameter"
 249   ;;"pause" "pointer" "precision" "print" "private" "procedure" "program"
 250   ;;"public" "read" "real" "recursive" "result" "return" "rewind" "save" "select"
 251   ;;"sequence" "stop" "subroutine" "target" "then" "type" "use" "where"
 252   ;;"while" "write")
 253   (concat
 254    "\\<\\(a\\(llocat\\(able\\|e\\)\\|ssign\\(\\|ment\\)\\)\\|b\\(ackspace\\|"
 255    "lock\\)\\|c\\(a\\(ll\\|se\\)\\|haracter\\|lose\\|o\\(m\\(mon\\|plex\\)\\|"
 256    "nt\\(ains\\|inue\\)\\)\\|ycle\\)\\|d\\(ata\\|eallocate\\|imension\\|"
 257    "o\\(\\|uble\\)\\)\\|e\\(lse\\(\\|if\\|where\\)\\|n\\(d\\(\\|do\\|file\\|"
 258    "if\\)\\|try\\)\\|quivalence\\|x\\(it\\|ternal\\)\\)\\|f\\(or\\(all\\|"
 259    "mat\\)\\|unction\\)\\|goto\\|i\\(f\\|mplicit\\|n\\(clude\\|quire\\|t\\("
 260    "e\\(ger\\|nt\\|rface\\)\\|rinsic\\)\\)\\)\\|logical\\|module\\|n\\("
 261    "amelist\\|one\\|ullify\\)\\|o\\(nly\\|p\\(en\\|erator\\|tional\\)\\)\\|p\\(a\\("
 262    "rameter\\|use\\)\\|ointer\\|r\\(ecision\\|i\\(nt\\|vate\\)\\|o\\("
 263    "cedure\\|gram\\)\\)\\|ublic\\)\\|re\\(a[dl]\\|cursive\\|sult\\|turn\\|wind\\)\\|"
 264    "s\\(ave\\|e\\(lect\\|quence\\)\\|top\\|ubroutine\\)\\|t\\(arget\\|hen\\|"
 265    "ype\\)\\|use\\|w\\(h\\(ere\\|ile\\)\\|rite\\)\\)\\>")
 266   "Regexp for F90 keywords.")
 267
 268 (defconst f90-keywords-level-3-re
 269   ;; ("allocate" "allocatable" "assign" "assignment" "backspace" "close"
 270   ;; "deallocate" "dimension" "endfile" "entry" "equivalence" "external"
 271   ;; "inquire" "intent" "intrinsic" "nullify" "only" "open" "operator"
 272   ;; "optional" "parameter" "pause" "pointer" "print" "private" "public"
 273   ;; "read" "recursive" "result" "rewind" "save" "select" "sequence"
 274   ;; "target"  "write")
 275   (concat
 276    "\\<\\(a\\(llocat\\(able\\|e\\)\\|ssign\\(\\|ment\\)\\)\\|backspace\\|"
 277    "close\\|d\\(eallocate\\|imension\\)\\|e\\(n\\(dfile\\|try\\)\\|"
 278    "quivalence\\|xternal\\)\\|"
 279    "in\\(quire\\|t\\(ent\\|rinsic\\)\\)\\|nullify\\|"
 280    "o\\(nly\\|p\\(en\\|erator\\|tional\\)\\)\\|"
 281    "p\\(a\\(rameter\\|use\\)\\|ointer\\|ri\\(nt\\|vate\\)\\|ublic\\)\\|re\\("
 282    "ad\\|cursive\\|sult\\|wind\\)\\|s\\(ave\\|e\\(lect\\|quence\\)\\)\\|target\\|"
 283    "write\\)\\>")
 284 "Keyword-regexp for font-lock level >= 3.")
 285
 286
 287 (defconst f90-procedures-re
 288   ;; ("abs" "achar" "acos" "adjustl" "adjustr" "aimag" "aint" "all" "allocated"
 289   ;; "anint" "any" "asin" "associated" "atan" "atan2" "bit_size" "btest"
 290   ;; "ceiling" "char" "cmplx" "conjg" "cos" "cosh" "count" "cshift"
 291   ;; "date_and_time" "dble" "digits" "dim" "dot_product" "dprod" "eoshift"
 292   ;; "epsilon" "exp" "exponent" "floor" "fraction" "huge" "iachar" "iand"
 293   ;; "ibclr" "ibits" "ibset" "ichar" "ieor" "index" "int" "ior" "ishft"
 294   ;; "ishftc" "kind" "lbound" "len" "len_trim" "lge" "lgt" "lle" "llt" "log"
 295   ;; "logical" "log10" "matmul" "max" "maxexponent" "maxloc" "maxval" "merge"
 296   ;; "min" "minexponent" "minloc" "minval" "mod" "modulo" "mvbits" "nearest"
 297   ;; "nint" "not" "pack" "precision" "present" "product" "radix"
 298   ;; "random_number" "random_seed" "range" "real" "repeat" "reshape"
 299   ;; "rrspacing" "scale" "scan" "selected_int_kind" "selected_real_kind"
 300   ;; "set_exponent" "shape" "sign" "sin" "sinh" "size" "spacing" "spread"
 301   ;; "sqrt" "sum" "system_clock" "tan" "tanh" "tiny" "transfer" "transpose"
 302   ;; "trim" "ubound" "unpack" "verify")
 303   ;; A left parenthesis to avoid highlighting non-procedures.
 304   ;; Real is taken out here to avoid highlighting declarations.
 305   (concat
 306    "\\<\\(a\\(bs\\|c\\(har\\|os\\)\\|djust[lr]\\|i\\(mag\\|nt\\)\\|ll\\(\\|"
 307    "ocated\\)\\|n\\(int\\|y\\)\\|s\\(in\\|sociated\\)\\|tan2?\\)\\|b\\("
 308    "it_size\\|test\\)\\|c\\(eiling\\|har\\|mplx\\|o\\(njg\\|sh?\\|unt\\)\\|"
 309    "shift\\)\\|d\\(ate_and_time\\|ble\\|i\\(gits\\|m\\)\\|ot_product\\|prod"
 310    "\\)\\|e\\(oshift\\|psilon\\|xp\\(\\|onent\\)\\)\\|f\\(loor\\|"
 311    "raction\\)\\|huge\\|i\\(a\\(char\\|nd\\)\\|b\\(clr\\|its\\|set\\)\\|"
 312    "char\\|eor\\|n\\(dex\\|t\\)\\|or\\|shftc?\\)\\|kind\\|l\\(bound\\|"
 313    "en\\(\\|_trim\\)\\|g[et]\\|l[et]\\|og\\(\\|10\\|ical\\)\\)\\|m\\(a\\("
 314    "tmul\\|x\\(\\|exponent\\|loc\\|val\\)\\)\\|erge\\|in\\(\\|exponent\\|"
 315    "loc\\|val\\)\\|od\\(\\|ulo\\)\\|vbits\\)\\|n\\(earest\\|int\\|ot\\)\\|"
 316    "p\\(ack\\|r\\(e\\(cision\\|sent\\)\\|oduct\\)\\)\\|r\\(a\\(dix\\|n\\("
 317    "dom_\\(number\\|seed\\)\\|ge\\)\\)\\|e\\(peat\\|shape\\)\\|rspacing\\)\\|"
 318    "s\\(ca\\(le\\|n\\)\\|e\\(lected_\\(int_kind\\|real_kind\\)\\|"
 319    "t_exponent\\)\\|hape\\|i\\(gn\\|nh?\\|ze\\)\\|p\\(acing\\|read\\)\\|"
 320    "qrt\\|um\\|ystem_clock\\)\\|t\\(anh?\\|iny\\|r\\(ans\\(fer\\|pose\\)\\|"
 321    "im\\)\\)\\|u\\(bound\\|npack\\)\\|verify\\)[ \t]*(")
 322   "Regexp whose first part matches F90 intrinsic procedures.")
 323
 324 (defconst f90-operators-re
 325 ;; "and" "or" "not" "eqv" "neqv" "eq" "ne" "lt" "le" "gt" "ge" "true" "false"
 326  (concat
 327    "\\.\\(and\\|eqv?\\|false\\|g[et]\\|l[et]\\|n\\(e\\(\\|qv\\)\\|"
 328    "ot\\)\\|or\\|true\\)\\.")
 329   "Regexp matching intrinsic operators.")
 330
 331 (defconst f90-hpf-keywords-re
 332   ;; Intrinsic procedures
 333   ;; ("all_prefix" "all_scatter" "all_suffix" "any_prefix" "any_scatter"
 334   ;; "any_suffix" "copy_prefix" "copy_scatter" "copy_suffix" "count_prefix"
 335   ;; "count_scatter" "count_suffix" "grade_down" "grade_up" "hpf_alignment"
 336   ;; "hpf_template" "hpf_distribution" "iall" "iall_prefix" "iall_scatter"
 337   ;; "iall_suffix" "iany" "iany_prefix" "iany_scatter" "iany_suffix" "iparity"
 338   ;; "iparity_prefix" "iparity_scatter" "iparity_suffix" "leadz"
 339   ;; "maxval_prefix" "maxval_scatter" "maxval_suffix" "minval_prefix"
 340   ;; "minval_scatter" "minval_suffix" "parity" "parity_prefix"
 341   ;; "parity_scatter" "parity_suffix" "popcnt" "poppar" "product_prefix"
 342   ;; "product_scatter" "product_suffix" "sum_prefix" "sum_scatter"
 343   ;; "sum_suffix" "ilen" "number_of_processors" "processors_shape")
 344   ;; Directives
 345   ;; ("align" "distribute" "dynamic" "inherit" "template" "processors"
 346   ;; "realign" "redistribute" "independent")
 347   ;; Keywords
 348   ;; ("pure" "extrinsic" "new" "with" "onto" "block" "cyclic")
 349   (concat
 350    "\\<\\(a\\(l\\(ign\\|l_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|ny_\\("
 351    "prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|block\\|c\\(o\\(py_\\(prefix\\|"
 352    "s\\(catter\\|uffix\\)\\)\\|unt_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|"
 353    "yclic\\)\\|d\\(istribute\\|ynamic\\)\\|extrinsic\\|grade_\\(down\\|"
 354    "up\\)\\|hpf_\\(alignment\\|distribution\\|template\\)\\|i\\(a\\(ll\\(\\|"
 355    "_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|ny\\(\\|_\\(prefix\\|s\\("
 356    "catter\\|uffix\\)\\)\\)\\)\\|len\\|n\\(dependent\\|herit\\)\\|parity\\(\\|"
 357    "_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\)\\|leadz\\|m\\(axval_\\("
 358    "prefix\\|s\\(catter\\|uffix\\)\\)\\|inval_\\(prefix\\|s\\(catter\\|"
 359    "uffix\\)\\)\\)\\|n\\(ew\\|umber_of_processors\\)\\|onto\\|p\\(arity\\(\\|"
 360    "_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|op\\(cnt\\|par\\)\\|ro\\("
 361    "cessors\\(\\|_shape\\)\\|duct_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|"
 362    "ure\\)\\|re\\(align\\|distribute\\)\\|sum_\\(prefix\\|s\\(catter\\|"
 363    "uffix\\)\\)\\|template\\|with\\)\\>")
 364   "Regexp for all HPF keywords, procedures and directives.")
 365
 366 ;; Highlighting patterns
 367
 368 (defvar f90-font-lock-keywords-1
 369   (list
 370    '("\\<\\(end[ \t]*\\(program\\|module\\|function\\|subroutine\\|type\\)\\)\\>[ \t]*\\(\\sw+\\)?"
 371      (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
 372    '("\\<\\(program\\|call\\|module\\|subroutine\\|function\\|use\\)\\>[ \t]*\\(\\sw+\\)?"
 373      (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
 374    ;; Special highlighting of "module procedure foo-list"
 375    '("\\<\\(module[ \t]*procedure\\)\\>" (1 font-lock-keyword-face t))
 376    ;; Highlight definition of new type
 377    '("\\<\\(type\\)[ \t]*\\(.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)"
 378      (1 font-lock-keyword-face) (3 font-lock-function-name-face))
 379    "\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>")
 380   "This does fairly subdued highlighting of comments and function calls.")
 381
 382 (defvar f90-font-lock-keywords-2
 383   (append f90-font-lock-keywords-1
 384       (list
 385        ;; Variable declarations (avoid the real function call)
 386        '("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\)\\(.*::\\|[ \t]*(.*)\\)?\\([^!\n]*\\)"
 387          (1 font-lock-type-face) (4 font-lock-variable-name-face))
 388        ;; do, if, select, where, and forall constructs
 389        '("\\<\\(end[ \t]*\\(do\\|if\\|select\\|forall\\|where\\)\\)\\>\\([ \t]+\\(\\sw+\\)\\)?"
 390          (1 font-lock-keyword-face) (3 font-lock-constant-face nil t))
 391        '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>"
 392          (2 font-lock-constant-face nil t) (3 font-lock-keyword-face))
 393        ;; implicit declaration
 394        '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\|none\\)\\>" (1 font-lock-keyword-face) (2 font-lock-type-face))
 395        '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
 396        "\\<else\\([ \t]*if\\|where\\)?\\>"
 397        "\\<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\>"
 398        '("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>"
 399          (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
 400        '("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1)
 401        '("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)"
 402          (1 font-lock-keyword-face) (2 font-lock-constant-face))
 403        ;; line numbers (lines whose first character after number is letter)
 404        '("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t))))
 405   "Highlights declarations, do-loops and other constructions")
 406
 407 (defvar f90-font-lock-keywords-3
 408   (append f90-font-lock-keywords-2
 409    (list
 410     f90-keywords-level-3-re
 411     f90-operators-re
 412     (list f90-procedures-re '(1 font-lock-keyword-face t))
 413    "\\<real\\>"                 ; Avoid overwriting real defs.
 414    ))
 415   "Highlights all F90 keywords and intrinsic procedures.")
 416
 417 (defvar f90-font-lock-keywords-4
 418   (append f90-font-lock-keywords-3
 419     (list f90-hpf-keywords-re))
 420   "Highlights all F90 and HPF keywords.")
 421
 422 (defvar f90-font-lock-keywords
 423       f90-font-lock-keywords-2
 424   "*Default expressions to highlight in F90 mode.")
 425
 426 ;; syntax table
 427 (defvar f90-mode-syntax-table nil
 428   "Syntax table in use in F90 mode buffers.")
 429
 430 (if f90-mode-syntax-table
 431     ()
 432   (setq f90-mode-syntax-table (make-syntax-table))
 433   (modify-syntax-entry ?\! "<" f90-mode-syntax-table)  ; beg. comment
 434   (modify-syntax-entry ?\n ">" f90-mode-syntax-table)  ; end comment
 435   (modify-syntax-entry ?_ "w" f90-mode-syntax-table)   ; underscore in names
 436   (modify-syntax-entry ?\' "\"" f90-mode-syntax-table) ; string quote
 437   (modify-syntax-entry ?\" "\"" f90-mode-syntax-table) ; string quote
 438   (modify-syntax-entry ?\` "w" f90-mode-syntax-table)  ; for abbrevs
 439   (modify-syntax-entry ?\r " " f90-mode-syntax-table)  ; return is whitespace
 440   (modify-syntax-entry ?+ "." f90-mode-syntax-table)
 441   (modify-syntax-entry ?- "." f90-mode-syntax-table)
 442   (modify-syntax-entry ?= "." f90-mode-syntax-table)
 443   (modify-syntax-entry ?* "." f90-mode-syntax-table)
 444   (modify-syntax-entry ?/ "." f90-mode-syntax-table)
 445   (modify-syntax-entry ?\\ "\\" f90-mode-syntax-table)) ; escape chars
 446
 447 ;; keys
 448 (defvar f90-mode-map ()
 449   "Keymap used in F90 mode.")
 450
 451 (if f90-mode-map
 452     ()
 453   (setq f90-mode-map (make-sparse-keymap))
 454   (define-key f90-mode-map "`"        'f90-abbrev-start)
 455   (define-key f90-mode-map "\C-c;"    'f90-comment-region)
 456   (define-key f90-mode-map "\C-\M-a"  'f90-beginning-of-subprogram)
 457   (define-key f90-mode-map "\C-\M-e"  'f90-end-of-subprogram)
 458   (define-key f90-mode-map "\C-\M-h"  'f90-mark-subprogram)
 459   (define-key f90-mode-map "\C-\M-q"  'f90-indent-subprogram)
 460   (define-key f90-mode-map "\C-j"     'f90-indent-new-line) ; LFD equals C-j
 461   (define-key f90-mode-map "\r"       'newline)
 462   (define-key f90-mode-map "\C-c\r"   'f90-break-line)
 463   ;;  (define-key f90-mode-map [M-return] 'f90-break-line)
 464   (define-key f90-mode-map "\C-c\C-d" 'f90-join-lines)
 465   (define-key f90-mode-map "\C-c\C-f" 'f90-fill-region)
 466   (define-key f90-mode-map "\C-c\C-p" 'f90-previous-statement)
 467   (define-key f90-mode-map "\C-c\C-n" 'f90-next-statement)
 468   (define-key f90-mode-map "\C-c\C-w" 'f90-insert-end)
 469   (define-key f90-mode-map "\t"       'f90-indent-line)
 470   (define-key f90-mode-map ","        'f90-electric-insert)
 471   (define-key f90-mode-map "+"        'f90-electric-insert)
 472   (define-key f90-mode-map "-"        'f90-electric-insert)
 473   (define-key f90-mode-map "*"        'f90-electric-insert)
 474   (define-key f90-mode-map "/"        'f90-electric-insert))
 475
 476
 477 ;; menus
 478 (if (string-match "XEmacs" emacs-version)
 479     (defvar f90-xemacs-menu
 480       '("F90"
 481         ["Indent Subprogram"       f90-indent-subprogram t]
 482         ["Mark Subprogram"         f90-mark-subprogram t]
 483         ["Beginning of Subprogram" f90-beginning-of-subprogram t]
 484         ["End of Subprogram"       f90-end-of-subprogram t]
 485         "-----"
 486         ["(Un)Comment Region"      f90-comment-region t]
 487         ["Indent Region"           indent-region t]
 488         ["Fill Region"             f90-fill-region t]
 489         "-----"
 490         ["Break Line at Point"     f90-break-line t]
 491         ["Join with Next Line"     f90-join-lines t]
 492         ["Insert Newline"          newline t]
 493         ["Insert Block End"        f90-insert-end t]
 494         "-----"
 495         ["Upcase Keywords (buffer)"      f90-upcase-keywords t]
 496         ["Upcase Keywords (region)"      f90-upcase-region-keywords
 497          t]
 498         ["Capitalize Keywords (buffer)"  f90-capitalize-keywords t]
 499         ["Capitalize Keywords (region)"
 500          f90-capitalize-region-keywords t]
 501         ["Downcase Keywords (buffer)"    f90-downcase-keywords t]
 502         ["Downcase Keywords (region)"
 503          f90-downcase-region-keywords t]
 504         "-----"
 505         ["Toggle abbrev-mode"   abbrev-mode             t]
 506         ["Toggle auto-fill"     auto-fill-mode          t])
 507       "XEmacs menu for F90 mode.")
 508   ;; Emacs
 509
 510   (defvar f90-change-case-menu
 511     (let ((map (make-sparse-keymap "Change Keyword Case")))
 512
 513       (define-key map [dkr] (cons "Downcase Keywords (region)"
 514                                   'f90-downcase-region-keywords))
 515       (put 'f90-downcase-region-keywords 'menu-enable 'mark-active)
 516
 517       (define-key map [ckr] (cons "Capitalize Keywords (region)"
 518                                   'f90-capitalize-region-keywords))
 519       (put 'f90-capitalize-region-keywords 'menu-enable 'mark-active)
 520
 521       (define-key map [ukr] (cons "Upcase Keywords (region)"
 522                                   'f90-upcase-region-keywords))
 523       (put 'f90-upcase-region-keywords 'menu-enable 'mark-active)
 524
 525       (define-key map [line] (list "-----------------"))
 526
 527       (define-key map [dkb] (cons "Downcase Keywords (buffer)"
 528                                   'f90-downcase-keywords))
 529
 530       (define-key map [ckb] (cons "Capitalize Keywords (buffer)"
 531                                   'f90-capitalize-keywords))
 532
 533       (define-key map [ukb] (cons "Upcase Keywords (buffer)"
 534                                   'f90-upcase-keywords))
 535       map)
 536     "Submenu for change of case.")
 537   (defalias 'f90-change-case-menu f90-change-case-menu)
 538
 539   ;; font-lock-menu and function calls
 540   (defalias 'f90-font-lock-on  'font-lock-mode)
 541   (defalias 'f90-font-lock-off 'font-lock-mode)
 542   (put 'f90-font-lock-on  'menu-enable 'font-lock-mode)
 543   (put 'f90-font-lock-off 'menu-enable '(not font-lock-mode))
 544
 545   (defun f90-font-lock-1 ()
 546     (interactive)
 547     "Set font-lock-keywords to f90-font-lock-keywords-1."
 548     (font-lock-mode 1)
 549     (setq font-lock-keywords f90-font-lock-keywords-1)
 550     (font-lock-fontify-buffer))
 551
 552   (defun f90-font-lock-2 ()
 553     (interactive)
 554     "Set font-lock-keywords to f90-font-lock-keywords-2."
 555     (font-lock-mode 1)
 556     (setq font-lock-keywords f90-font-lock-keywords-2)
 557     (font-lock-fontify-buffer))
 558
 559   (defun f90-font-lock-3 ()
 560     (interactive)
 561     "Set font-lock-keywords to f90-font-lock-keywords-3."
 562     (font-lock-mode 1)
 563     (setq font-lock-keywords f90-font-lock-keywords-3)
 564     (font-lock-fontify-buffer))
 565
 566   (defun f90-font-lock-4 ()
 567     (interactive)
 568     "Set font-lock-keywords to f90-font-lock-keywords-4."
 569     (font-lock-mode 1)
 570     (setq font-lock-keywords f90-font-lock-keywords-4)
 571     (font-lock-fontify-buffer))
 572
 573   (defvar f90-font-lock-menu
 574     (let ((map (make-sparse-keymap "f90-font-lock-menu")))
 575       (define-key map [h4] (cons "Maximum highlighting (level 4)"
 576                                  'f90-font-lock-4))
 577       (define-key map [h3] (cons "Heavy highlighting (level 3)"
 578                                  'f90-font-lock-3))
 579       (define-key map [h2] (cons "Default highlighting (level 2)"
 580                                  'f90-font-lock-2))
 581       (define-key map [h1] (cons "Light highlighting (level 1)"
 582                                  'f90-font-lock-1))
 583       (define-key map [line] (list "-----------------"))
 584       (define-key map [floff] (cons "Turn off font-lock-mode"
 585                                     'f90-font-lock-on))
 586       (define-key map [flon] (cons "Turn on font-lock-mode"
 587                                    'f90-font-lock-off))
 588       map)
 589     "Submenu for highlighting using font-lock-mode.")
 590   (defalias 'f90-font-lock-menu f90-font-lock-menu)
 591
 592   (define-key f90-mode-map [menu-bar] (make-sparse-keymap))
 593   (define-key f90-mode-map [menu-bar f90]
 594     (cons "F90" (make-sparse-keymap "f90")))
 595
 596   (define-key f90-mode-map [menu-bar f90 f90-imenu-menu]
 597     '("Add imenu Menu" . f90-add-imenu-menu))
 598   (define-key f90-mode-map [menu-bar f90 abbrev-mode]
 599     '("Toggle abbrev-mode" . abbrev-mode))
 600   (define-key f90-mode-map [menu-bar f90 auto-fill-mode]
 601     '("Toggle auto-fill" . auto-fill-mode))
 602   (define-key f90-mode-map [menu-bar f90 line1]
 603     '("----"))
 604   (define-key f90-mode-map [menu-bar f90 f90-change-case-menu]
 605     (cons "Change Keyword Case" 'f90-change-case-menu))
 606   (define-key f90-mode-map [menu-bar f90 f90-font-lock-menu]
 607     (cons "Highlighting" 'f90-font-lock-menu))
 608   (define-key f90-mode-map [menu-bar f90 line2]
 609     '("----"))
 610
 611   (define-key f90-mode-map [menu-bar f90 f90-insert-end]
 612     '("Insert Block End" . f90-insert-end))
 613   (define-key f90-mode-map [menu-bar f90 f90-join-lines]
 614     '("Join with Next Line" . f90-join-lines))
 615   (define-key f90-mode-map [menu-bar f90 f90-break-line]
 616     '("Break Line at Point" . f90-break-line))
 617
 618   (define-key f90-mode-map [menu-bar f90 line3]
 619     '("----"))
 620
 621   (define-key f90-mode-map [menu-bar f90 f90-fill-region]
 622     '("Fill Region" . f90-fill-region))
 623   (put 'f90-fill-region 'menu-enable 'mark-active)
 624
 625   (define-key f90-mode-map [menu-bar f90 indent-region]
 626     '("Indent Region" . indent-region))
 627
 628   (define-key f90-mode-map [menu-bar f90 f90-comment-region]
 629     '("(Un)Comment Region" . f90-comment-region))
 630   (put 'f90-comment-region 'menu-enable 'mark-active)
 631
 632   (define-key f90-mode-map [menu-bar f90 line4]
 633     '("----"))
 634
 635   (define-key f90-mode-map [menu-bar f90 f90-end-of-subprogram]
 636     '("End of Subprogram" . f90-end-of-subprogram))
 637   (define-key f90-mode-map [menu-bar f90 f90-beginning-of-subprogram]
 638     '("Beginning of Subprogram" . f90-beginning-of-subprogram))
 639   (define-key f90-mode-map [menu-bar f90 f90-mark-subprogram]
 640     '("Mark Subprogram" . f90-mark-subprogram))
 641   (define-key f90-mode-map [menu-bar f90 f90-indent-subprogram]
 642     '("Indent Subprogram" . f90-indent-subprogram))
 643   )
 644
 645 ;; Regexps for finding program structures.
 646 (defconst f90-blocks-re
 647   "\\(block[ \t]*data\\|do\\|if\\|interface\\|function\\|module\\|\
 648 program\\|select\\|subroutine\\|type\\|where\\|forall\\)\\>")
 649 (defconst f90-program-block-re
 650   "\\(program\\|module\\|subroutine\\|function\\)")
 651 (defconst f90-else-like-re
 652   "\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\)")
 653 (defconst f90-end-if-re
 654   "end[ \t]*\\(if\\|select\\|where\\|forall\\)\\>")
 655 (defconst f90-end-type-re
 656   "end[ \t]*\\(type\\|interface\\|block[ \t]*data\\)")
 657 (defconst f90-type-def-re
 658   "\\<\\(type\\)\\([^(\n]*\\)\\(::\\)?[ \t]*\\b\\(\\sw+\\)")
 659 (defconst f90-no-break-re  "\\(\\*\\*\\|//\\|=>\\)")
 660 ;; A temporary position to make region operators faster
 661 (defvar f90-cache-position nil)
 662 (make-variable-buffer-local 'f90-cache-position)
 663 ;; A flag to tell whether f90-imenu is turned on.
 664 (defvar f90-imenu nil)
 665 (make-variable-buffer-local 'f90-imenu)
 666
 667 \f
 668 ;; Imenu support
 669 (defvar f90-imenu-generic-expression
 670   (let ((good-char "[^!\"\&\n \t]") (not-e "[^e!\n\"\& \t]")
 671         (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]"))
 672     (list
 673      '(nil "^[ \t0-9]*program[ \t]+\\(\\sw+\\)" 1)
 674      '("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1)
 675      '("Types" "^[ \t0-9]*type[ \t]+\\(\\sw+\\)" 1)
 676      (list
 677       "Procedures"
 678       (concat
 679        "^[ \t0-9]*"
 680        "\\("
 681        ;; At least three non-space characters before function/subroutine
 682        ;; Check that the last three non-space characters don't spell E N D
 683        "[^!\"\&\n]*\\("
 684        not-e good-char good-char "\\|"
 685        good-char not-n good-char "\\|"
 686        good-char good-char not-d "\\)"
 687        "\\|"
 688        ;; Less than three non-space characters before function/subroutine
 689        good-char "?" good-char "?"
 690        "\\)"
 691        "[ \t]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)")
 692     4)))
 693   "imenu generic expression for F90 mode.")
 694
 695 (defun f90-add-imenu-menu ()
 696   (interactive)
 697   "Add an imenu menu to the menubar."
 698   (if (not f90-imenu)
 699       (progn
 700         (imenu-add-to-menubar "F90-imenu")
 701         (redraw-frame (selected-frame))
 702         (setq f90-imenu t))
 703     (message "%s" "F90-imenu already exists.")))
 704 (put 'f90-add-imenu-menu 'menu-enable '(not f90-imenu))
 705
 706
 707 ;; When compiling under GNU Emacs, load imenu during compilation.  If
 708 ;; you have 19.22 or earlier, comment this out, or get imenu.
 709 (and (fboundp 'eval-when-compile)
 710      (eval-when-compile
 711        (if (not (string-match "XEmacs" emacs-version))
 712            (require 'imenu))
 713        ()))
 714 \f
 715 ;; abbrevs have generally two letters, except standard types `c, `i, `r, `t
 716 (defvar f90-mode-abbrev-table nil)
 717 (if f90-mode-abbrev-table
 718     ()
 719   (let ((ac abbrevs-changed))
 720     (define-abbrev-table 'f90-mode-abbrev-table ())
 721     (define-abbrev f90-mode-abbrev-table  "`al"  "allocate" nil)
 722     (define-abbrev f90-mode-abbrev-table  "`ab"  "allocatable" nil)
 723     (define-abbrev f90-mode-abbrev-table  "`as"  "assignment" nil)
 724     (define-abbrev f90-mode-abbrev-table  "`ba"  "backspace" nil)
 725     (define-abbrev f90-mode-abbrev-table  "`bd"  "block data" nil)
 726     (define-abbrev f90-mode-abbrev-table  "`c"   "character" nil)
 727     (define-abbrev f90-mode-abbrev-table  "`cl"  "close" nil)
 728     (define-abbrev f90-mode-abbrev-table  "`cm"  "common" nil)
 729     (define-abbrev f90-mode-abbrev-table  "`cx"  "complex" nil)
 730     (define-abbrev f90-mode-abbrev-table  "`cn"  "contains" nil)
 731     (define-abbrev f90-mode-abbrev-table  "`cy"  "cycle" nil)
 732     (define-abbrev f90-mode-abbrev-table  "`de"  "deallocate" nil)
 733     (define-abbrev f90-mode-abbrev-table  "`df"  "define" nil)
 734     (define-abbrev f90-mode-abbrev-table  "`di"  "dimension" nil)
 735     (define-abbrev f90-mode-abbrev-table  "`dw"  "do while" nil)
 736     (define-abbrev f90-mode-abbrev-table  "`el"  "else" nil)
 737     (define-abbrev f90-mode-abbrev-table  "`eli" "else if" nil)
 738     (define-abbrev f90-mode-abbrev-table  "`elw" "elsewhere" nil)
 739     (define-abbrev f90-mode-abbrev-table  "`eq"  "equivalence" nil)
 740     (define-abbrev f90-mode-abbrev-table  "`ex"  "external" nil)
 741     (define-abbrev f90-mode-abbrev-table  "`ey"  "entry" nil)
 742     (define-abbrev f90-mode-abbrev-table  "`fl"  "forall" nil)
 743     (define-abbrev f90-mode-abbrev-table  "`fo"  "format" nil)
 744     (define-abbrev f90-mode-abbrev-table  "`fu"  "function" nil)
 745     (define-abbrev f90-mode-abbrev-table  "`fa"  ".false." nil)
 746     (define-abbrev f90-mode-abbrev-table  "`im"  "implicit none" nil)
 747     (define-abbrev f90-mode-abbrev-table  "`in " "include" nil)
 748     (define-abbrev f90-mode-abbrev-table  "`i"   "integer" nil)
 749     (define-abbrev f90-mode-abbrev-table  "`it"  "intent" nil)
 750     (define-abbrev f90-mode-abbrev-table  "`if"  "interface" nil)
 751     (define-abbrev f90-mode-abbrev-table  "`lo"  "logical" nil)
 752     (define-abbrev f90-mode-abbrev-table  "`mo"  "module" nil)
 753     (define-abbrev f90-mode-abbrev-table  "`na"  "namelist" nil)
 754     (define-abbrev f90-mode-abbrev-table  "`nu"  "nullify" nil)
 755     (define-abbrev f90-mode-abbrev-table  "`op"  "optional" nil)
 756     (define-abbrev f90-mode-abbrev-table  "`pa"  "parameter" nil)
 757     (define-abbrev f90-mode-abbrev-table  "`po"  "pointer" nil)
 758     (define-abbrev f90-mode-abbrev-table  "`pr"  "print" nil)
 759     (define-abbrev f90-mode-abbrev-table  "`pi"  "private" nil)
 760     (define-abbrev f90-mode-abbrev-table  "`pm"  "program" nil)
 761     (define-abbrev f90-mode-abbrev-table  "`pu"  "public" nil)
 762     (define-abbrev f90-mode-abbrev-table  "`r"   "real" nil)
 763     (define-abbrev f90-mode-abbrev-table  "`rc"  "recursive" nil)
 764     (define-abbrev f90-mode-abbrev-table  "`rt"  "return" nil)
 765     (define-abbrev f90-mode-abbrev-table  "`rw"  "rewind" nil)
 766     (define-abbrev f90-mode-abbrev-table  "`se"  "select" nil)
 767     (define-abbrev f90-mode-abbrev-table  "`sq"  "sequence" nil)
 768     (define-abbrev f90-mode-abbrev-table  "`su"  "subroutine" nil)
 769     (define-abbrev f90-mode-abbrev-table  "`ta"  "target" nil)
 770     (define-abbrev f90-mode-abbrev-table  "`tr"  ".true." nil)
 771     (define-abbrev f90-mode-abbrev-table  "`t"   "type" nil)
 772     (define-abbrev f90-mode-abbrev-table  "`wh"  "where" nil)
 773     (define-abbrev f90-mode-abbrev-table  "`wr"  "write" nil)
 774     (setq abbrevs-changed ac)))
 775 \f
 776 (defcustom f90-mode-hook nil
 777   "Hook run by F90 mode."
 778   :type 'hook
 779   :options '(f90-add-imenu-menu)
 780   :group 'f90)
 781
 782 ;;;###autoload
 783 (defun f90-mode ()
 784   "Major mode for editing Fortran 90 code in free format.
 785
 786 \\[f90-indent-new-line] corrects current indentation and creates new\
 787  indented line.
 788 \\[f90-indent-line] indents the current line correctly.
 789 \\[f90-indent-subprogram] indents the current subprogram.
 790
 791 Type `? or `\\[help-command] to display a list of built-in\
 792  abbrevs for F90 keywords.
 793
 794 Key definitions:
 795 \\{f90-mode-map}
 796
 797 Variables controlling indentation style and extra features:
 798
 799  f90-do-indent
 800     Extra indentation within do blocks.  (default 3)
 801  f90-if-indent
 802     Extra indentation within if/select case/where/forall blocks. (default 3)
 803  f90-type-indent
 804     Extra indentation within type/interface/block-data blocks.  (default 3)
 805  f90-program-indent
 806     Extra indentation within program/module/subroutine/function blocks.
 807       (default 2)
 808  f90-continuation-indent
 809     Extra indentation applied to continuation lines.  (default 5)
 810  f90-comment-region
 811     String inserted by \\[f90-comment-region] at start of each line in
 812     region.  (default \"!!!$\")
 813  f90-indented-comment-re
 814     Regexp determining the type of comment to be intended like code.
 815     (default \"!\")
 816  f90-directive-comment-re
 817     Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented.
 818     (default \"!hpf\\\\$\")
 819  f90-break-delimiters
 820     Regexp holding list of delimiters at which lines may be broken.
 821     (default \"[-+*/><=,% \\t]\")
 822  f90-break-before-delimiters
 823     Non-nil causes `f90-do-auto-fill' to break lines before delimiters.
 824     (default t)
 825  f90-beginning-ampersand
 826     Automatic insertion of \& at beginning of continuation lines. (default t)
 827  f90-smart-end
 828     From an END statement, check and fill the end using matching block start.
 829     Allowed values are 'blink, 'no-blink, and nil, which determine
 830     whether to blink the matching beginning.) (default 'blink)
 831  f90-auto-keyword-case
 832     Automatic change of case of keywords. (default nil)
 833     The possibilities are 'downcase-word, 'upcase-word, 'capitalize-word.
 834  f90-leave-line-no
 835     Do not left-justify line numbers. (default nil)
 836  f90-startup-message
 837     Set to nil to inhibit message first time F90 mode is used. (default t)
 838  f90-keywords-re
 839     List of keywords used for highlighting/upcase-keywords etc.
 840
 841 Turning on F90 mode calls the value of the variable `f90-mode-hook'
 842 with no args, if that value is non-nil."
 843   (interactive)
 844   (kill-all-local-variables)
 845   (setq major-mode 'f90-mode)
 846   (setq mode-name "F90")
 847   (setq local-abbrev-table f90-mode-abbrev-table)
 848   (set-syntax-table f90-mode-syntax-table)
 849   (use-local-map f90-mode-map)
 850   (make-local-variable 'indent-line-function)
 851   (setq indent-line-function 'f90-indent-line)
 852   (make-local-variable 'indent-region-function)
 853   (setq indent-region-function 'f90-indent-region)
 854   (make-local-variable 'require-final-newline)
 855   (setq require-final-newline t)
 856   (make-local-variable 'comment-start)
 857   (setq comment-start "!")
 858   (make-local-variable 'comment-start-skip)
 859   (setq comment-start-skip "!+ *")
 860   (make-local-variable 'comment-indent-function)
 861   (setq comment-indent-function 'f90-comment-indent)
 862   (make-local-variable 'abbrev-all-caps)
 863   (setq abbrev-all-caps t)
 864   (make-local-variable 'normal-auto-fill-function)
 865   (setq normal-auto-fill-function 'f90-do-auto-fill)
 866   (setq indent-tabs-mode nil)
 867   ;; Setting up things for font-lock
 868   (if (string-match "XEmacs" emacs-version)
 869       (progn
 870         (put 'f90-mode 'font-lock-keywords-case-fold-search t)
 871         (if (and (featurep 'menubar)
 872                  current-menubar
 873                  (not (assoc "F90" current-menubar)))
 874             (progn
 875               (set-buffer-menubar (copy-sequence current-menubar))
 876               (add-submenu nil f90-xemacs-menu)))))
 877   ;; XEmacs: (Don't need a special case, since both emacsen work alike -sb)
 878   (make-local-variable 'font-lock-defaults)
 879   (setq font-lock-defaults
 880         '((f90-font-lock-keywords f90-font-lock-keywords-1
 881                                   f90-font-lock-keywords-2
 882                                   f90-font-lock-keywords-3
 883                                   f90-font-lock-keywords-4)
 884           nil t))
 885   ;; Tell imenu how to handle f90.
 886   (set (make-local-variable 'imenu-case-fold-search) t)
 887   (make-local-variable 'imenu-generic-expression)
 888   (setq imenu-generic-expression f90-imenu-generic-expression)
 889   (set (make-local-variable 'add-log-current-defun-function)
 890        #'f90-current-defun)
 891   (run-hooks 'f90-mode-hook)
 892   (if f90-startup-message
 893       (message "Emacs F90 mode; please report bugs to %s" bug-f90-mode))
 894   (setq f90-startup-message nil))
 895 \f
 896 ;; inline-functions
 897 (defsubst f90-get-beg-of-line ()
 898   (save-excursion (beginning-of-line) (point)))
 899
 900 (defsubst f90-get-end-of-line ()
 901   (save-excursion (end-of-line) (point)))
 902
 903 (defsubst f90-in-string ()
 904   (let ((beg-pnt
 905          (if (and f90-cache-position (> (point) f90-cache-position))
 906              f90-cache-position
 907            (point-min))))
 908     (nth 3 (parse-partial-sexp beg-pnt (point)))))
 909
 910 (defsubst f90-in-comment ()
 911   (let ((beg-pnt
 912          (if (and f90-cache-position (> (point) f90-cache-position))
 913              f90-cache-position
 914            (point-min))))
 915     (nth 4 (parse-partial-sexp beg-pnt (point)))))
 916
 917 (defsubst f90-line-continued ()
 918   (save-excursion
 919     (let ((bol (f90-get-beg-of-line)))
 920       (end-of-line)
 921       (while (f90-in-comment)
 922         (search-backward "!" bol)
 923         (skip-chars-backward "!"))
 924       (skip-chars-backward " \t")
 925       (= (preceding-char) ?&))))
 926
 927 (defsubst f90-current-indentation ()
 928   "Return indentation of current line.
 929 Line-numbers are considered whitespace characters."
 930   (save-excursion
 931     (beginning-of-line) (skip-chars-forward " \t0-9")
 932     (current-column)))
 933
 934 (defsubst f90-indent-to (col &optional no-line-number)
 935   "Indent current line to column COL.
 936 If no-line-number nil, jump over a possible line-number."
 937   (beginning-of-line)
 938   (if (not no-line-number)
 939       (skip-chars-forward " \t0-9"))
 940   (delete-horizontal-space)
 941   (if (zerop (current-column))
 942       (indent-to col)
 943     (indent-to col 1)))
 944
 945 (defsubst f90-match-piece (arg)
 946   (if (match-beginning arg)
 947       (buffer-substring (match-beginning arg) (match-end arg))))
 948
 949 (defsubst f90-get-present-comment-type ()
 950   (save-excursion
 951     (let ((type nil) (eol (f90-get-end-of-line)))
 952       (if (f90-in-comment)
 953           (progn
 954             (beginning-of-line)
 955             (re-search-forward "[!]+" eol)
 956             (while (f90-in-string)
 957               (re-search-forward "[!]+" eol))
 958             (setq type (buffer-substring (match-beginning 0) (match-end 0)))))
 959       type)))
 960
 961 (defsubst f90-equal-symbols (a b)
 962   "Compare strings neglecting case and allowing for nil value."
 963   (let ((a-local (if a (downcase a) nil))
 964         (b-local (if b (downcase b) nil)))
 965     (equal a-local b-local)))
 966
 967 ;; XEmacs 19.11 & 19.12 gives back a single char when matching an empty regular
 968 ;; expression. Therefore, the next 2 functions are longer than necessary.
 969
 970 (defsubst f90-looking-at-do ()
 971   "Return (\"do\" name) if a do statement starts after point.
 972 Name is nil if the statement has no label."
 973   (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(do\\)\\>")
 974       (let (label
 975             (struct (f90-match-piece 3)))
 976         (if (looking-at "\\(\\sw+\\)[ \t]*\:")
 977             (setq label (f90-match-piece 1)))
 978         (list struct label))))
 979
 980 (defsubst f90-looking-at-select-case ()
 981   "Return (\"select\" name) if a select-case statement starts after point.
 982 Name is nil if the statement has no label."
 983   (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(select\\)[ \t]*case[ \t]*(")
 984       (let (label
 985             (struct (f90-match-piece 3)))
 986         (if (looking-at "\\(\\sw+\\)[ \t]*\:")
 987             (setq label (f90-match-piece 1)))
 988         (list struct label))))
 989
 990 (defsubst f90-looking-at-if-then ()
 991   "Return (\"if\" name) if an if () then statement starts after point.
 992 Name is nil if the statement has no label."
 993   (save-excursion
 994     (let (struct (label nil))
 995       (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>")
 996           (progn
 997             (setq struct (f90-match-piece 3))
 998             (if (looking-at "\\(\\sw+\\)[ \t]*\:")
 999                 (setq label (f90-match-piece 1)))
1000             (let ((pos (scan-lists (point) 1 0)))
1001               (and pos (goto-char pos)))
1002             (skip-chars-forward " \t")
1003             (if (or (looking-at "then\\>")
1004                     (if (f90-line-continued)
1005                         (progn
1006                           (f90-next-statement)
1007                           (skip-chars-forward " \t0-9&")
1008                           (looking-at "then\\>"))))
1009                 (list struct label)))))))
1010
1011 (defsubst f90-looking-at-where-or-forall ()
1012   "Return (kind name) if a where or forall block starts after point.
1013 Name is nil if the statement has no label."
1014   (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)")
1015       (let (label
1016             (struct (f90-match-piece 3)))
1017         (if (looking-at "\\(\\sw+\\)[ \t]*\:")
1018             (setq label (f90-match-piece 1)))
1019         (list struct label))))
1020
1021 (defsubst f90-looking-at-type-like ()
1022   "Return (kind name) at the start of a type/interface/block-data block.
1023 Name is non-nil only for type."
1024   (cond
1025    ((looking-at f90-type-def-re)
1026     (list (f90-match-piece 1) (f90-match-piece 4)))
1027    ((looking-at "\\(interface\\|block[\t]*data\\)\\>")
1028     (list (f90-match-piece 1) nil))))
1029
1030 (defsubst f90-looking-at-program-block-start ()
1031   "Return (kind name) if a program block with name name starts after point."
1032   (cond
1033    ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>")
1034     (list (f90-match-piece 1) (f90-match-piece 2)))
1035    ((and (not (looking-at "module[ \t]*procedure\\>"))
1036          (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>"))
1037     (list (f90-match-piece 1) (f90-match-piece 2)))
1038    ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)"))
1039          (looking-at "[^!\"\&\n]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)"))
1040     (list (f90-match-piece 1) (f90-match-piece 2)))))
1041
1042 (defsubst f90-looking-at-program-block-end ()
1043   "Return list of type and name of end of block."
1044   (if (looking-at (concat "end[ \t]*" f90-blocks-re
1045                           "?\\([ \t]+\\(\\sw+\\)\\)?\\>"))
1046       (list (f90-match-piece 1) (f90-match-piece 3))))
1047
1048 (defsubst f90-comment-indent ()
1049   (cond ((looking-at "!!!") 0)
1050         ((and f90-directive-comment-re
1051               (looking-at f90-directive-comment-re)) 0)
1052         ((looking-at (regexp-quote f90-comment-region)) 0)
1053         ((and (looking-at f90-indented-comment-re)
1054               ;; Don't attempt to indent trailing comment as code.
1055               (save-excursion
1056                 (skip-chars-backward " \t")
1057                 (bolp)))
1058          (f90-calculate-indent))
1059         (t (skip-chars-backward " \t")
1060            (max (if (bolp) 0 (1+ (current-column))) comment-column))))
1061
1062 (defsubst f90-present-statement-cont ()
1063   "Return continuation properties of present statement."
1064   (let (pcont cont)
1065     (save-excursion
1066       (setq pcont (if (f90-previous-statement) (f90-line-continued) nil)))
1067     (setq cont (f90-line-continued))
1068     (cond ((and (not pcont) (not cont)) 'single)
1069           ((and (not pcont) cont)       'begin)
1070           ((and pcont       (not cont)) 'end)
1071           ((and pcont       cont)       'middle)
1072           (t (error)))))
1073
1074 (defsubst f90-indent-line-no ()
1075   (if f90-leave-line-no
1076       ()
1077     (if (and (not (zerop (skip-chars-forward " \t")))
1078              (looking-at "[0-9]"))
1079         (delete-horizontal-space)))
1080   (skip-chars-forward " \t0-9"))
1081
1082 (defsubst f90-no-block-limit ()
1083   (let ((eol (f90-get-end-of-line)))
1084     (save-excursion
1085       (not (or (looking-at "end")
1086                (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\
1087 \\|select[ \t]*case\\|case\\|where\\|forall\\)\\>")
1088                (looking-at "\\(program\\|module\\|interface\\|\
1089 block[ \t]*data\\)\\>")
1090                (looking-at "\\(contains\\|\\sw+[ \t]*:\\)")
1091                (looking-at f90-type-def-re)
1092                (re-search-forward "\\(function\\|subroutine\\)" eol t))))))
1093
1094 (defsubst f90-update-line ()
1095   (let (bol eol)
1096     (if f90-auto-keyword-case
1097         (progn (setq bol (f90-get-beg-of-line)
1098                      eol (f90-get-end-of-line))
1099                (if f90-auto-keyword-case
1100                    (f90-change-keywords f90-auto-keyword-case bol eol))))))
1101 \f
1102 (defun f90-electric-insert ()
1103   (interactive)
1104   "Calls f90-do-auto-fill at each operator insertion."
1105   (self-insert-command 1)
1106   (f90-update-line)
1107   (if auto-fill-function (f90-do-auto-fill)))
1108
1109 (defun f90-get-correct-indent ()
1110   "Get correct indent for a line starting with line number.
1111 Does not check type and subprogram indentation."
1112   (let ((epnt (f90-get-end-of-line)) icol cont)
1113     (save-excursion
1114       (while (and (f90-previous-statement)
1115                   (or (progn
1116                         (setq cont (f90-present-statement-cont))
1117                         (or (eq cont 'end) (eq cont 'middle)))
1118                       (looking-at "[ \t]*[0-9]"))))
1119       (setq icol (current-indentation))
1120       (beginning-of-line)
1121       (if (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)"
1122                              (f90-get-end-of-line) t)
1123           (progn
1124             (beginning-of-line) (skip-chars-forward " \t")
1125             (cond ((f90-looking-at-do)
1126                    (setq icol (+ icol f90-do-indent)))
1127                   ((or (f90-looking-at-if-then)
1128                        (f90-looking-at-where-or-forall)
1129                        (f90-looking-at-select-case))
1130                    (setq icol (+ icol f90-if-indent))))
1131             (end-of-line)))
1132       (while (re-search-forward
1133               "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t)
1134         (beginning-of-line) (skip-chars-forward " \t0-9")
1135         (cond  ((f90-looking-at-do)
1136                 (setq icol (+ icol f90-do-indent)))
1137                ((or (f90-looking-at-if-then)
1138                     (f90-looking-at-where-or-forall)
1139                     (f90-looking-at-select-case))
1140                 (setq icol (+ icol f90-if-indent)))
1141                ((looking-at f90-end-if-re)
1142                 (setq icol (- icol f90-if-indent)))
1143                ((looking-at "end[ \t]*do\\>")
1144                 (setq icol (- icol f90-do-indent))))
1145         (end-of-line))
1146       icol)))
1147
1148
1149 (defun f90-calculate-indent ()
1150   "Calculate the indent column based on previous statements."
1151   (interactive)
1152   (let (icol cont (case-fold-search t) (pnt (point)))
1153     (save-excursion
1154       (if (not (f90-previous-statement))
1155           (setq icol 0)
1156         (setq cont (f90-present-statement-cont))
1157         (if (eq cont 'end)
1158             (while (not (eq 'begin (f90-present-statement-cont)))
1159               (f90-previous-statement)))
1160         (cond ((eq cont 'begin)
1161                (setq icol (+ (f90-current-indentation)
1162                              f90-continuation-indent)))
1163               ((eq cont 'middle) (setq icol(current-indentation)))
1164               (t (setq icol (f90-current-indentation))
1165                  (skip-chars-forward " \t")
1166                  (if (looking-at "[0-9]")
1167                      (setq icol (f90-get-correct-indent))
1168                    (cond ((or (f90-looking-at-if-then)
1169                               (f90-looking-at-where-or-forall)
1170                               (f90-looking-at-select-case)
1171                               (looking-at f90-else-like-re))
1172                           (setq icol (+ icol f90-if-indent)))
1173                          ((f90-looking-at-do)
1174                           (setq icol (+ icol f90-do-indent)))
1175                          ((f90-looking-at-type-like)
1176                           (setq icol (+ icol f90-type-indent)))
1177                          ((or (f90-looking-at-program-block-start)
1178                               (looking-at "contains[ \t]*\\($\\|!\\)"))
1179                           (setq icol (+ icol f90-program-indent)))))
1180                  (goto-char pnt)
1181                  (beginning-of-line)
1182                  (cond ((looking-at "[ \t]*$"))
1183                        ((looking-at "[ \t]*#") ; Check for cpp directive.
1184                         (setq icol 0))
1185                        (t
1186                         (skip-chars-forward " \t0-9")
1187                         (cond ((or (looking-at f90-else-like-re)
1188                                    (looking-at f90-end-if-re))
1189                                (setq icol (- icol f90-if-indent)))
1190                               ((looking-at "end[ \t]*do\\>")
1191                                (setq icol (- icol f90-do-indent)))
1192                               ((looking-at f90-end-type-re)
1193                                (setq icol (- icol f90-type-indent)))
1194                               ((or (looking-at "contains[ \t]*\\(!\\|$\\)")
1195                                    (f90-looking-at-program-block-end))
1196                                (setq icol (- icol f90-program-indent))))))
1197                  ))))
1198     icol))
1199 \f
1200 ;; Statement = statement line, a line which is neither blank, nor a comment.
1201 (defun f90-previous-statement ()
1202   "Move point to beginning of the previous F90 statement.
1203 Return nil if no previous statement is found."
1204   (interactive)
1205   (let (not-first-statement)
1206     (beginning-of-line)
1207     (while (and (setq not-first-statement (zerop (forward-line -1)))
1208                 (looking-at "[ \t0-9]*\\(!\\|$\\|#\\)")))
1209     not-first-statement))
1210
1211 (defun f90-next-statement ()
1212   "Move point to beginning of the next F90 statement.
1213 Return nil if no later statement is found."
1214   (interactive)
1215   (let (not-last-statement)
1216     (beginning-of-line)
1217     (while (and (setq not-last-statement
1218                       (and (zerop (forward-line 1))
1219                            (not (eobp))))
1220                 (looking-at "[ \t0-9]*\\(!\\|$\\)")))
1221     not-last-statement))
1222
1223 (defun f90-beginning-of-subprogram ()
1224   "Move point to the beginning of subprogram.
1225 Return (type name) or nil if not found."
1226   (interactive)
1227   (let ((count 1) (case-fold-search t) matching-beg)
1228     (beginning-of-line) (skip-chars-forward " \t0-9")
1229     (if (setq matching-beg (f90-looking-at-program-block-start))
1230         (setq count (- count 1)))
1231     (while (and (not (zerop count))
1232                 (re-search-backward f90-program-block-re nil 'move))
1233       (beginning-of-line) (skip-chars-forward " \t0-9")
1234       (cond
1235        ((setq matching-beg (f90-looking-at-program-block-start))
1236         (setq count (- count 1)))
1237        ((f90-looking-at-program-block-end)
1238         (setq count (+ count 1)))))
1239     (beginning-of-line)
1240     (if (zerop count)
1241         matching-beg
1242       (message "No beginning-found.")
1243       nil)))
1244
1245 (defun f90-end-of-subprogram ()
1246   "Move point to the end of subprogram.
1247 Return (type name) or nil if not found."
1248   (interactive)
1249   (let ((count 1) (case-fold-search t) matching-end)
1250     (beginning-of-line) (skip-chars-forward " \t0-9")
1251     (if (setq matching-end (f90-looking-at-program-block-end))
1252         (setq count (1- count)))
1253     (end-of-line)
1254     (while (and (not (zerop count))
1255                 (re-search-forward f90-program-block-re nil 'move))
1256       (beginning-of-line) (skip-chars-forward " \t0-9")
1257       (cond ((f90-looking-at-program-block-start)
1258              (setq count (+ count 1)))
1259             ((setq matching-end (f90-looking-at-program-block-end))
1260              (setq count (1- count ))))
1261       (end-of-line))
1262     (forward-line 1)
1263     (if (zerop count)
1264         matching-end
1265       (message "No end found.")
1266       nil)))
1267
1268 (defun f90-mark-subprogram ()
1269   "Put mark at end of F90 subprogram, point at beginning.
1270 Marks are pushed and highlight (grey shadow) is turned on."
1271   (interactive)
1272   (let ((pos (point)) program)
1273     (f90-end-of-subprogram)
1274     (push-mark (point) t)
1275     (goto-char pos)
1276     (setq program (f90-beginning-of-subprogram))
1277     ;; The keywords in the preceding lists assume case-insensitivity.
1278     (if (string-match "XEmacs" emacs-version)
1279         (zmacs-activate-region)
1280       (setq mark-active t)
1281       (setq deactivate-mark nil))
1282     program))
1283
1284 (defun f90-comment-region (beg-region end-region)
1285   "Comment/uncomment every line in the region.
1286 Insert f90-comment-region at the beginning of every line in the region
1287 or, if already present, remove it."
1288   (interactive "*r")
1289   (let ((end (make-marker)))
1290     (set-marker end end-region)
1291     (goto-char beg-region)
1292     (beginning-of-line)
1293     (if (looking-at (regexp-quote f90-comment-region))
1294         (delete-region (point) (match-end 0))
1295       (insert f90-comment-region))
1296     (while (and  (zerop (forward-line 1))
1297                  (< (point) (marker-position end)))
1298       (if (looking-at (regexp-quote f90-comment-region))
1299           (delete-region (point) (match-end 0))
1300         (insert f90-comment-region)))
1301     (set-marker end nil)))
1302
1303 (defun f90-indent-line (&optional no-update)
1304   "Indent current line as F90 code."
1305   (interactive)
1306   (let (indent (no-line-number nil) (pos (make-marker)) (case-fold-search t))
1307     (set-marker pos (point))
1308     (beginning-of-line)                 ; Digits after & \n are not line-no
1309     (if (save-excursion (and (f90-previous-statement) (f90-line-continued)))
1310         (progn (setq no-line-number t) (skip-chars-forward " \t"))
1311       (f90-indent-line-no))
1312     (if (looking-at "!")
1313         (setq indent (f90-comment-indent))
1314       (if (and (looking-at "end") f90-smart-end)
1315             (f90-match-end))
1316       (setq indent (f90-calculate-indent)))
1317     (if (zerop (- indent (current-column)))
1318         nil
1319       (f90-indent-to indent no-line-number))
1320     ;; If initial point was within line's indentation,
1321     ;; position after the indentation.  Else stay at same point in text.
1322     (if (< (point) (marker-position pos))
1323         (goto-char (marker-position pos)))
1324     (if (not no-update) (f90-update-line))
1325     (if auto-fill-function (f90-do-auto-fill))
1326     (set-marker pos nil)))
1327
1328 (defun f90-indent-new-line ()
1329   "Reindent the current F90 line, insert a newline and indent the newline.
1330 An abbrev before point is expanded if `abbrev-mode' is non-nil.
1331 If run in the middle of a line, the line is not broken."
1332   (interactive)
1333   (let (string cont (case-fold-search t))
1334     (if abbrev-mode (expand-abbrev))
1335     (beginning-of-line)                 ; Reindent where likely to be needed.
1336     (f90-indent-line-no)
1337     (if (or (looking-at "\\(end\\|else\\|!\\)"))
1338         (f90-indent-line 'no-update))
1339     (end-of-line)
1340     (delete-horizontal-space)           ;Destroy trailing whitespace
1341     (setq string (f90-in-string))
1342     (setq cont (f90-line-continued))
1343     (if (and string (not cont)) (insert "&"))
1344     (f90-update-line)
1345     (newline)
1346     (if (or string (and cont f90-beginning-ampersand)) (insert "&"))
1347     (f90-indent-line 'no-update)))
1348
1349
1350 (defun f90-indent-region (beg-region end-region)
1351   "Indent every line in region by forward parsing."
1352   (interactive "*r")
1353   (let ((end-region-mark (make-marker)) (save-point (point-marker))
1354         (block-list nil) ind-lev ind-curr ind-b cont
1355         struct beg-struct end-struct)
1356     (set-marker end-region-mark end-region)
1357     (goto-char beg-region)
1358     ;; first find a line which is not a continuation line or comment
1359     (beginning-of-line)
1360     (while (and (looking-at "[ \t]*[0-9]*\\(!\\|#\\|[ \t]*$\\)")
1361                 (progn (f90-indent-line 'no-update)
1362                        (zerop (forward-line 1)))
1363                 (< (point) end-region-mark)))
1364     (setq cont (f90-present-statement-cont))
1365     (while (and (or (eq cont 'middle) (eq cont 'end))
1366                 (f90-previous-statement))
1367       (setq cont (f90-present-statement-cont)))
1368     ;; process present line for beginning of block
1369     (setq f90-cache-position (point))
1370     (f90-indent-line 'no-update)
1371     (setq ind-lev (f90-current-indentation))
1372     (setq ind-curr ind-lev)
1373     (beginning-of-line) (skip-chars-forward " \t0-9")
1374     (setq struct nil)
1375     (setq ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent)
1376                       ((or (setq struct (f90-looking-at-if-then))
1377                            (setq struct (f90-looking-at-select-case))
1378                            (setq struct (f90-looking-at-where-or-forall))
1379                            (looking-at f90-else-like-re))
1380                        f90-if-indent)
1381                       ((setq struct (f90-looking-at-type-like))
1382                        f90-type-indent)
1383                       ((or(setq struct (f90-looking-at-program-block-start))
1384                           (looking-at "contains[ \t]*\\($\\|!\\)"))
1385                        f90-program-indent)))
1386     (if ind-b (setq ind-lev (+ ind-lev ind-b)))
1387     (if struct (setq block-list (cons struct block-list)))
1388     (while (and (f90-line-continued) (zerop (forward-line 1))
1389                 (< (point) end-region-mark))
1390       (if (not (zerop (- (current-indentation)
1391                          (+ ind-curr f90-continuation-indent))))
1392           (f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no)))
1393     ;; process all following lines
1394     (while (and  (zerop (forward-line 1)) (< (point) end-region-mark))
1395       (beginning-of-line)
1396       (f90-indent-line-no)
1397       (setq f90-cache-position (point))
1398       (cond ((looking-at "[ \t]*$") (setq ind-curr 0))
1399             ((looking-at "[ \t]*#") (setq ind-curr 0))
1400             ((looking-at "!") (setq ind-curr (f90-comment-indent)))
1401             ((f90-no-block-limit) (setq ind-curr ind-lev))
1402             ((looking-at f90-else-like-re) (setq ind-curr
1403                                                  (- ind-lev f90-if-indent)))
1404             ((looking-at "contains[ \t]*\\($\\|!\\)")
1405              (setq ind-curr (- ind-lev f90-program-indent)))
1406             ((setq ind-b
1407                    (cond ((setq struct (f90-looking-at-do)) f90-do-indent)
1408                          ((or (setq struct (f90-looking-at-if-then))
1409                               (setq struct (f90-looking-at-select-case))
1410                               (setq struct (f90-looking-at-where-or-forall)))
1411                           f90-if-indent)
1412                          ((setq struct (f90-looking-at-type-like))
1413                           f90-type-indent)
1414                          ((setq struct (f90-looking-at-program-block-start))
1415                           f90-program-indent)))
1416              (setq ind-curr ind-lev)
1417              (if ind-b (setq ind-lev (+ ind-lev ind-b)))
1418              (setq block-list (cons struct block-list)))
1419             ((setq end-struct (f90-looking-at-program-block-end))
1420              (setq beg-struct (car block-list)
1421                    block-list (cdr block-list))
1422              (if f90-smart-end
1423                  (save-excursion
1424                    (f90-block-match (car beg-struct)(car (cdr beg-struct))
1425                                     (car end-struct)(car (cdr end-struct)))))
1426              (setq ind-b
1427                    (cond ((looking-at f90-end-if-re) f90-if-indent)
1428                          ((looking-at "end[ \t]*do\\>")  f90-do-indent)
1429                          ((looking-at f90-end-type-re) f90-type-indent)
1430                          ((f90-looking-at-program-block-end)
1431                           f90-program-indent)))
1432              (if ind-b (setq ind-lev (- ind-lev ind-b)))
1433              (setq ind-curr ind-lev))
1434             (t (setq ind-curr ind-lev)))
1435       ;; do the indentation if necessary
1436       (if (not (zerop (- ind-curr (current-column))))
1437           (f90-indent-to ind-curr))
1438       (while (and (f90-line-continued) (zerop (forward-line 1))
1439                   (< (point) end-region-mark))
1440         (if (not (zerop (- (current-indentation)
1441                            (+ ind-curr f90-continuation-indent))))
1442             (f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no))))
1443     ;; restore point etc
1444     (setq f90-cache-position nil)
1445     (goto-char save-point)
1446     (set-marker end-region-mark nil)
1447     (set-marker save-point nil)
1448     (if (string-match "XEmacs" emacs-version)
1449         (zmacs-deactivate-region)
1450       (deactivate-mark))))
1451
1452 (defun f90-indent-subprogram ()
1453   "Properly indent the subprogram which contains point."
1454   (interactive)
1455   (save-excursion
1456     (let (program)
1457       (setq program (f90-mark-subprogram))
1458       (if program
1459           (progn
1460             (message "Indenting %s %s..."
1461                      (car program) (car (cdr program)))
1462             (f90-indent-region (point) (mark))
1463             (message "Indenting %s %s...done"
1464                      (car program) (car (cdr program))))
1465         (message "Indenting the whole file...")
1466         (f90-indent-region (point) (mark))
1467         (message "Indenting the whole file...done")))))
1468
1469 ;; autofill and break-line
1470 (defun f90-break-line (&optional no-update)
1471   "Break line at point, insert continuation marker(s) and indent."
1472   (interactive)
1473   (let (ctype)
1474     (cond ((f90-in-string)
1475            (insert "&") (newline) (insert "&"))
1476           ((f90-in-comment)
1477            (setq ctype (f90-get-present-comment-type))
1478            (newline)
1479            (insert ctype))
1480           (t (insert "&")
1481              (if (not no-update) (f90-update-line))
1482              (newline)
1483              (if f90-beginning-ampersand (insert "&")))))
1484   (f90-indent-line))
1485
1486 (defun f90-find-breakpoint ()
1487   "From fill-column, search backward for break-delimiter."
1488   (let ((bol (f90-get-beg-of-line)))
1489     (re-search-backward f90-break-delimiters bol)
1490     (if f90-break-before-delimiters
1491         (progn (backward-char)
1492                (if (not (looking-at f90-no-break-re))
1493                    (forward-char)))
1494       (if (looking-at f90-no-break-re)
1495           (forward-char 2)
1496         (forward-char)))))
1497
1498 (defun f90-do-auto-fill ()
1499   "Break line if non-white characters beyond fill-column. Also, update line. "
1500   (interactive)
1501   ;; Break the line before or after the last delimiter (non-word char) if
1502   ;; position is beyond fill-column.
1503   ;; Will not break **, //, or => (specified by f90-no-break-re).
1504   (f90-update-line)
1505   (while (> (current-column) fill-column)
1506       (let ((pos-mark (point-marker)))
1507         (move-to-column fill-column)
1508         (if (not (f90-in-string))
1509             (f90-find-breakpoint))
1510         (f90-break-line)
1511         (goto-char pos-mark)
1512         (set-marker pos-mark nil))))
1513
1514
1515 (defun f90-join-lines ()
1516   "Join present line with next line, if this line ends with \&."
1517   (interactive)
1518   (let (pos (oldpos (point)))
1519     (end-of-line)
1520     (skip-chars-backward " \t")
1521     (cond ((= (preceding-char) ?&)
1522            (delete-char -1)
1523            (setq pos (point))
1524            (forward-line 1)
1525            (skip-chars-forward " \t")
1526            (if (looking-at "\&") (delete-char 1))
1527            (delete-region pos (point))
1528            (if (not (f90-in-string))
1529                (progn (delete-horizontal-space) (insert " ")))
1530            (if (and auto-fill-function
1531                     (> (save-excursion (end-of-line)
1532                                        (current-column))
1533                        fill-column))
1534                (f90-do-auto-fill))
1535            (goto-char oldpos)
1536            t))))
1537
1538 (defun f90-fill-region (beg-region end-region)
1539   "Fill every line in region by forward parsing. Join lines if possible."
1540   (interactive "*r")
1541   (let ((end-region-mark (make-marker))
1542         (f90-smart-end nil) (f90-auto-keyword-case nil) (go-on t)
1543         (auto-fill-function nil))
1544     (set-marker end-region-mark end-region)
1545     (goto-char beg-region)
1546     (while go-on
1547       ;; join as much as possible
1548       (while (f90-join-lines))
1549       ;; chop the line if necessary
1550       (while (> (save-excursion (end-of-line) (current-column))
1551                 fill-column)
1552         (move-to-column fill-column)
1553         (f90-find-breakpoint)
1554         (f90-break-line 'no-update))
1555       (setq go-on (and  (< (point) (marker-position end-region-mark))
1556                         (zerop (forward-line 1))))
1557       (setq f90-cache-position (point)))
1558     (setq f90-cache-position nil)
1559     (if (string-match "XEmacs" emacs-version)
1560         (zmacs-deactivate-region)
1561       (deactivate-mark))))
1562 \f
1563 (defun f90-block-match (beg-block beg-name end-block end-name)
1564   "Match end-struct with beg-struct and complete end-block if possible.
1565 Leave point at the end of line."
1566   (search-forward "end" (f90-get-end-of-line))
1567   (catch 'no-match
1568     (if (not (f90-equal-symbols beg-block end-block))
1569         (if end-block
1570             (progn
1571               (message "END %s does not match %s." end-block beg-block)
1572               (end-of-line)
1573               (throw 'no-match nil))
1574           (message "Inserting %s." beg-block)
1575           (insert (concat " " beg-block)))
1576       (search-forward end-block))
1577     (if (not (f90-equal-symbols beg-name end-name))
1578         (cond ((and beg-name (not end-name))
1579                (message "Inserting %s." beg-name)
1580                (insert (concat " " beg-name)))
1581               ((and beg-name end-name)
1582                (message "Replacing %s with %s." end-name beg-name)
1583                (search-forward end-name)
1584                (replace-match beg-name))
1585               ((and (not beg-name) end-name)
1586                (message "Deleting %s." end-name)
1587                (search-forward end-name)
1588                (replace-match "")))
1589       (if end-name (search-forward end-name)))
1590     (if (not (looking-at "[ \t]*!")) (delete-horizontal-space))))
1591
1592 (defun f90-match-end ()
1593   "From an end foo statement, find the corresponding foo including name."
1594   (interactive)
1595   (let ((count 1) (top-of-window (window-start)) (matching-beg nil)
1596         (end-point (point)) (case-fold-search t)
1597         beg-name end-name beg-block end-block end-struct)
1598     (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")
1599                         (setq end-struct (f90-looking-at-program-block-end)))
1600         (progn
1601           (setq end-block (car end-struct))
1602           (setq end-name  (car (cdr end-struct)))
1603           (save-excursion
1604             (beginning-of-line)
1605             (while
1606                 (and (not (zerop count))
1607                      (let ((stop nil) notexist)
1608                        (while (not stop)
1609                          (setq notexist
1610                                (not (re-search-backward
1611                                      (concat "\\(" f90-blocks-re "\\)") nil t)))
1612                          (if notexist
1613                              (setq stop t)
1614                            (setq stop
1615                                  (not (or (f90-in-string)
1616                                           (f90-in-comment))))))
1617                        (not notexist)))
1618               (beginning-of-line) (skip-chars-forward " \t0-9")
1619               (cond ((setq matching-beg
1620                            (cond
1621                             ((f90-looking-at-do))
1622                             ((f90-looking-at-if-then))
1623                             ((f90-looking-at-where-or-forall))
1624                             ((f90-looking-at-select-case))
1625                             ((f90-looking-at-type-like))
1626                             ((f90-looking-at-program-block-start))))
1627                      (setq count (- count 1)))
1628                     ((looking-at (concat "end[ \t]*" f90-blocks-re "\\b"))
1629                      (setq count (+ count 1)))))
1630             (if (not (zerop count))
1631                 (message "No matching beginning.")
1632               (f90-update-line)
1633               (if (eq f90-smart-end 'blink)
1634                   (if (< (point) top-of-window)
1635                       (message "Matches %s: %s"
1636                                (what-line)
1637                                (buffer-substring
1638                                 (progn (beginning-of-line) (point))
1639                                 (progn (end-of-line) (point))))
1640                     (sit-for 1)))
1641               (setq beg-block (car matching-beg))
1642               (setq beg-name (car (cdr matching-beg)))
1643               (goto-char end-point)
1644               (beginning-of-line)
1645               (f90-block-match beg-block beg-name end-block end-name)))))))
1646
1647 (defun f90-insert-end ()
1648   "Inserts an complete end statement matching beginning of present block."
1649   (interactive)
1650   (let ((f90-smart-end (if f90-smart-end f90-smart-end 'blink)))
1651     (insert "end")
1652     (f90-indent-new-line)))
1653 \f
1654 ;; abbrevs and keywords
1655
1656 (defun f90-abbrev-start ()
1657   "Typing `\\[help-command] or `? lists all the F90 abbrevs.
1658 Any other key combination is executed normally."
1659   (interactive)
1660   (let (e c)
1661     (insert last-command-char)
1662     (if (string-match "XEmacs" emacs-version)
1663         (progn
1664           (setq e (next-command-event))
1665           (setq c (event-to-character e)))
1666       (setq c (read-event)))
1667     ;; insert char if not equal to `?'
1668     (if (or (eq c ??) (eq c help-char))
1669         (f90-abbrev-help)
1670       (if (string-match "XEmacs" emacs-version)
1671           (setq unread-command-event e)
1672         (setq unread-command-events (list c))))))
1673
1674 (defun f90-abbrev-help ()
1675   "List the currently defined abbrevs in F90 mode."
1676   (interactive)
1677   (message "Listing abbrev table...")
1678   (display-buffer (f90-prepare-abbrev-list-buffer))
1679   (message "Listing abbrev table...done"))
1680
1681 (defun f90-prepare-abbrev-list-buffer ()
1682   (save-excursion
1683     (set-buffer (get-buffer-create "*Abbrevs*"))
1684     (erase-buffer)
1685     (insert-abbrev-table-description 'f90-mode-abbrev-table t)
1686     (goto-char (point-min))
1687     (set-buffer-modified-p nil)
1688     (edit-abbrevs-mode))
1689   (get-buffer-create "*Abbrevs*"))
1690
1691 (defun f90-upcase-keywords ()
1692   "Upcase all F90 keywords in the buffer."
1693   (interactive)
1694   (f90-change-keywords 'upcase-word))
1695
1696 (defun f90-capitalize-keywords ()
1697   "Capitalize all F90 keywords in the buffer."
1698   (interactive)
1699   (f90-change-keywords 'capitalize-word))
1700
1701 (defun f90-downcase-keywords ()
1702   "Downcase all F90 keywords in the buffer."
1703   (interactive)
1704   (f90-change-keywords 'downcase-word))
1705
1706 (defun f90-upcase-region-keywords (beg end)
1707   "Upcase all F90 keywords in the region."
1708   (interactive "*r")
1709   (f90-change-keywords 'upcase-word beg end))
1710
1711 (defun f90-capitalize-region-keywords (beg end)
1712   "Capitalize all F90 keywords in the region."
1713   (interactive "*r")
1714   (f90-change-keywords 'capitalize-word beg end))
1715
1716 (defun f90-downcase-region-keywords (beg end)
1717   "Downcase all F90 keywords in the region."
1718   (interactive "*r")
1719   (f90-change-keywords 'downcase-word beg end))
1720
1721 ;; Change the keywords according to argument.
1722 (defun f90-change-keywords (change-word &optional beg end)
1723   (save-excursion
1724     (setq beg (if beg beg (point-min)))
1725     (setq end (if end end (point-max)))
1726     (let ((keyword-re
1727            (concat "\\("
1728                    f90-keywords-re "\\|" f90-procedures-re "\\|"
1729                    f90-hpf-keywords-re "\\|" f90-operators-re "\\)"))
1730           (ref-point (point-min)) state
1731           (modified (buffer-modified-p)) saveword back-point)
1732       (goto-char beg)
1733       (unwind-protect
1734           (while (re-search-forward keyword-re end t)
1735             (if (progn
1736                   (setq state (parse-partial-sexp ref-point (point)))
1737                   (or (nth 3 state) (nth 4 state)
1738                       (save-excursion   ; Check for cpp directive.
1739                         (beginning-of-line)
1740                         (skip-chars-forward " \t0-9")
1741                         (looking-at "#"))))
1742                 ()
1743               (setq ref-point (point)
1744                     back-point (save-excursion (backward-word 1) (point)))
1745               (setq saveword (buffer-substring back-point ref-point))
1746               (funcall change-word -1)
1747               (or (string= saveword (buffer-substring back-point ref-point))
1748                   (setq modified t))))
1749         (or modified (set-buffer-modified-p nil))))))
1750
1751
1752 (defun f90-current-defun ()
1753   "Function to use for `add-log-current-defun-function' in F90 mode."
1754   (save-excursion
1755     (nth 1 (f90-beginning-of-subprogram))))
1756
1757 (provide 'f90)
1758
1759 ;;; f90.el ends here