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