code.delx.au - gnu-emacs/blob - lisp/progmodes/f90.el

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