lisp/progmodes/f90.el

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