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

   1 ;;; f90.el --- Fortran-90 mode (free format)
   2
   3 ;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: Torbj\"orn Einarsson <T.Einarsson@clab.ericsson.se>
   6 ;; Last Change: Dec 29 1998
   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 'boolean
 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
 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-constant-face nil t))
 392        '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>"
 393          (2 font-lock-constant-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-constant-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-constant-face nil t))
 401        '("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1)
 402        '("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)"
 403          (1 font-lock-keyword-face) (2 font-lock-constant-face))
 404        ;; line numbers (lines whose first character after number is letter)
 405        '("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-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     (list f90-procedures-re '(1 font-lock-keyword-face t))
 414    "\\<real\\>"                 ; Avoid overwriting real defs.
 415    ))
 416   "Highlights all F90 keywords and intrinsic procedures.")
 417
 418 (defvar f90-font-lock-keywords-4
 419   (append f90-font-lock-keywords-3
 420     (list f90-hpf-keywords-re))
 421   "Highlights all F90 and HPF keywords.")
 422
 423 (defvar f90-font-lock-keywords
 424       f90-font-lock-keywords-2
 425   "*Default expressions to highlight in F90 mode.")
 426
 427 ;; syntax table
 428 (defvar f90-mode-syntax-table nil
 429   "Syntax table in use in F90 mode buffers.")
 430
 431 (if f90-mode-syntax-table
 432     ()
 433   (setq f90-mode-syntax-table (make-syntax-table))
 434   (modify-syntax-entry ?\! "<" f90-mode-syntax-table)  ; beg. comment
 435   (modify-syntax-entry ?\n ">" f90-mode-syntax-table)  ; end comment
 436   (modify-syntax-entry ?_ "w" f90-mode-syntax-table)   ; underscore in names
 437   (modify-syntax-entry ?\' "\"" f90-mode-syntax-table) ; string quote
 438   (modify-syntax-entry ?\" "\"" f90-mode-syntax-table) ; string quote
 439   (modify-syntax-entry ?\` "w" f90-mode-syntax-table)  ; for abbrevs
 440   (modify-syntax-entry ?\r " " f90-mode-syntax-table)  ; return is whitespace
 441   (modify-syntax-entry ?+ "." f90-mode-syntax-table)
 442   (modify-syntax-entry ?- "." f90-mode-syntax-table)
 443   (modify-syntax-entry ?= "." f90-mode-syntax-table)
 444   (modify-syntax-entry ?* "." f90-mode-syntax-table)
 445   (modify-syntax-entry ?/ "." f90-mode-syntax-table)
 446   (modify-syntax-entry ?\\ "/" f90-mode-syntax-table)) ; escape chars
 447
 448 ;; keys
 449 (defvar f90-mode-map ()
 450   "Keymap used in F90 mode.")
 451
 452 (if f90-mode-map
 453     ()
 454   (setq f90-mode-map (make-sparse-keymap))
 455   (define-key f90-mode-map "`"        'f90-abbrev-start)
 456   (define-key f90-mode-map "\C-c;"    'f90-comment-region)
 457   (define-key f90-mode-map "\C-\M-a"  'f90-beginning-of-subprogram)
 458   (define-key f90-mode-map "\C-\M-e"  'f90-end-of-subprogram)
 459   (define-key f90-mode-map "\C-\M-h"  'f90-mark-subprogram)
 460   (define-key f90-mode-map "\C-\M-q"  'f90-indent-subprogram)
 461   (define-key f90-mode-map "\C-j"     'f90-indent-new-line) ; LFD equals C-j
 462   (define-key f90-mode-map "\r"       'newline)
 463   (define-key f90-mode-map "\C-c\r"   'f90-break-line)
 464   ;;  (define-key f90-mode-map [M-return] 'f90-break-line)
 465   (define-key f90-mode-map "\C-c\C-d" 'f90-join-lines)
 466   (define-key f90-mode-map "\C-c\C-f" 'f90-fill-region)
 467   (define-key f90-mode-map "\C-c\C-p" 'f90-previous-statement)
 468   (define-key f90-mode-map "\C-c\C-n" 'f90-next-statement)
 469   (define-key f90-mode-map "\C-c\C-w" 'f90-insert-end)
 470   (define-key f90-mode-map "\t"       'f90-indent-line)
 471   (define-key f90-mode-map ","        'f90-electric-insert)
 472   (define-key f90-mode-map "+"        'f90-electric-insert)
 473   (define-key f90-mode-map "-"        'f90-electric-insert)
 474   (define-key f90-mode-map "*"        'f90-electric-insert)
 475   (define-key f90-mode-map "/"        'f90-electric-insert))
 476
 477
 478 ;; menus
 479 (if (string-match "XEmacs" emacs-version)
 480     (defvar f90-xemacs-menu
 481       '("F90"
 482         ["Indent Subprogram"       f90-indent-subprogram t]
 483         ["Mark Subprogram"         f90-mark-subprogram t]
 484         ["Beginning of Subprogram" f90-beginning-of-subprogram t]
 485         ["End of Subprogram"       f90-end-of-subprogram t]
 486         "-----"
 487         ["(Un)Comment Region"      f90-comment-region t]
 488         ["Indent Region"           indent-region t]
 489         ["Fill Region"             f90-fill-region t]
 490         "-----"
 491         ["Break Line at Point"     f90-break-line t]
 492         ["Join with Next Line"     f90-join-lines t]
 493         ["Insert Newline"          newline t]
 494         ["Insert Block End"        f90-insert-end t]
 495         "-----"
 496         ["Upcase Keywords (buffer)"      f90-upcase-keywords t]
 497         ["Upcase Keywords (region)"      f90-upcase-region-keywords
 498          t]
 499         ["Capitalize Keywords (buffer)"  f90-capitalize-keywords t]
 500         ["Capitalize Keywords (region)"
 501          f90-capitalize-region-keywords t]
 502         ["Downcase Keywords (buffer)"    f90-downcase-keywords t]
 503         ["Downcase Keywords (region)"
 504          f90-downcase-region-keywords t]
 505         "-----"
 506         ["Toggle abbrev-mode"   abbrev-mode             t]
 507         ["Toggle auto-fill"     auto-fill-mode          t])
 508       "XEmacs menu for F90 mode.")
 509   ;; Emacs
 510
 511   (defvar f90-change-case-menu
 512     (let ((map (make-sparse-keymap "Change Keyword Case")))
 513
 514       (define-key map [dkr] (cons "Downcase Keywords (region)"
 515                                   'f90-downcase-region-keywords))
 516       (put 'f90-downcase-region-keywords 'menu-enable 'mark-active)
 517
 518       (define-key map [ckr] (cons "Capitalize Keywords (region)"
 519                                   'f90-capitalize-region-keywords))
 520       (put 'f90-capitalize-region-keywords 'menu-enable 'mark-active)
 521
 522       (define-key map [ukr] (cons "Upcase Keywords (region)"
 523                                   'f90-upcase-region-keywords))
 524       (put 'f90-upcase-region-keywords 'menu-enable 'mark-active)
 525
 526       (define-key map [line] (list "-----------------"))
 527
 528       (define-key map [dkb] (cons "Downcase Keywords (buffer)"
 529                                   'f90-downcase-keywords))
 530
 531       (define-key map [ckb] (cons "Capitalize Keywords (buffer)"
 532                                   'f90-capitalize-keywords))
 533
 534       (define-key map [ukb] (cons "Upcase Keywords (buffer)"
 535                                   'f90-upcase-keywords))
 536       map)
 537     "Submenu for change of case.")
 538   (defalias 'f90-change-case-menu f90-change-case-menu)
 539
 540   ;; font-lock-menu and function calls
 541   (defalias 'f90-font-lock-on  'font-lock-mode)
 542   (defalias 'f90-font-lock-off 'font-lock-mode)
 543   (put 'f90-font-lock-on  'menu-enable 'font-lock-mode)
 544   (put 'f90-font-lock-off 'menu-enable '(not font-lock-mode))
 545
 546   (defun f90-font-lock-1 ()
 547     (interactive)
 548     "Set font-lock-keywords to f90-font-lock-keywords-1."
 549     (font-lock-mode 1)
 550     (setq font-lock-keywords f90-font-lock-keywords-1)
 551     (font-lock-fontify-buffer))
 552
 553   (defun f90-font-lock-2 ()
 554     (interactive)
 555     "Set font-lock-keywords to f90-font-lock-keywords-2."
 556     (font-lock-mode 1)
 557     (setq font-lock-keywords f90-font-lock-keywords-2)
 558     (font-lock-fontify-buffer))
 559
 560   (defun f90-font-lock-3 ()
 561     (interactive)
 562     "Set font-lock-keywords to f90-font-lock-keywords-3."
 563     (font-lock-mode 1)
 564     (setq font-lock-keywords f90-font-lock-keywords-3)
 565     (font-lock-fontify-buffer))
 566
 567   (defun f90-font-lock-4 ()
 568     (interactive)
 569     "Set font-lock-keywords to f90-font-lock-keywords-4."
 570     (font-lock-mode 1)
 571     (setq font-lock-keywords f90-font-lock-keywords-4)
 572     (font-lock-fontify-buffer))
 573
 574   (defvar f90-font-lock-menu
 575     (let ((map (make-sparse-keymap "f90-font-lock-menu")))
 576       (define-key map [h4] (cons "Maximum highlighting (level 4)"
 577                                  'f90-font-lock-4))
 578       (define-key map [h3] (cons "Heavy highlighting (level 3)"
 579                                  'f90-font-lock-3))
 580       (define-key map [h2] (cons "Default highlighting (level 2)"
 581                                  'f90-font-lock-2))
 582       (define-key map [h1] (cons "Light highlighting (level 1)"
 583                                  'f90-font-lock-1))
 584       (define-key map [line] (list "-----------------"))
 585       (define-key map [floff] (cons "Turn off font-lock-mode"
 586                                     'f90-font-lock-on))
 587       (define-key map [flon] (cons "Turn on font-lock-mode"
 588                                    'f90-font-lock-off))
 589       map)
 590     "Submenu for highlighting using font-lock-mode.")
 591   (defalias 'f90-font-lock-menu f90-font-lock-menu)
 592
 593   (define-key f90-mode-map [menu-bar] (make-sparse-keymap))
 594   (define-key f90-mode-map [menu-bar f90]
 595     (cons "F90" (make-sparse-keymap "f90")))
 596
 597   (define-key f90-mode-map [menu-bar f90 f90-imenu-menu]
 598     '("Add imenu Menu" . f90-add-imenu-menu))
 599   (define-key f90-mode-map [menu-bar f90 abbrev-mode]
 600     '("Toggle abbrev-mode" . abbrev-mode))
 601   (define-key f90-mode-map [menu-bar f90 auto-fill-mode]
 602     '("Toggle auto-fill" . auto-fill-mode))
 603   (define-key f90-mode-map [menu-bar f90 line1]
 604     '("----"))
 605   (define-key f90-mode-map [menu-bar f90 f90-change-case-menu]
 606     (cons "Change Keyword Case" 'f90-change-case-menu))
 607   (define-key f90-mode-map [menu-bar f90 f90-font-lock-menu]
 608     (cons "Highlighting" 'f90-font-lock-menu))
 609   (define-key f90-mode-map [menu-bar f90 line2]
 610     '("----"))
 611
 612   (define-key f90-mode-map [menu-bar f90 f90-insert-end]
 613     '("Insert Block End" . f90-insert-end))
 614   (define-key f90-mode-map [menu-bar f90 f90-join-lines]
 615     '("Join with Next Line" . f90-join-lines))
 616   (define-key f90-mode-map [menu-bar f90 f90-break-line]
 617     '("Break Line at Point" . f90-break-line))
 618
 619   (define-key f90-mode-map [menu-bar f90 line3]
 620     '("----"))
 621
 622   (define-key f90-mode-map [menu-bar f90 f90-fill-region]
 623     '("Fill Region" . f90-fill-region))
 624   (put 'f90-fill-region 'menu-enable 'mark-active)
 625
 626   (define-key f90-mode-map [menu-bar f90 indent-region]
 627     '("Indent Region" . indent-region))
 628
 629   (define-key f90-mode-map [menu-bar f90 f90-comment-region]
 630     '("(Un)Comment Region" . f90-comment-region))
 631   (put 'f90-comment-region 'menu-enable 'mark-active)
 632
 633   (define-key f90-mode-map [menu-bar f90 line4]
 634     '("----"))
 635
 636   (define-key f90-mode-map [menu-bar f90 f90-end-of-subprogram]
 637     '("End of Subprogram" . f90-end-of-subprogram))
 638   (define-key f90-mode-map [menu-bar f90 f90-beginning-of-subprogram]
 639     '("Beginning of Subprogram" . f90-beginning-of-subprogram))
 640   (define-key f90-mode-map [menu-bar f90 f90-mark-subprogram]
 641     '("Mark Subprogram" . f90-mark-subprogram))
 642   (define-key f90-mode-map [menu-bar f90 f90-indent-subprogram]
 643     '("Indent Subprogram" . f90-indent-subprogram))
 644   )
 645
 646 ;; Regexps for finding program structures.
 647 (defconst f90-blocks-re
 648   "\\(block[ \t]*data\\|do\\|if\\|interface\\|function\\|module\\|\
 649 program\\|select\\|subroutine\\|type\\|where\\|forall\\)\\>")
 650 (defconst f90-program-block-re
 651   "\\(program\\|module\\|subroutine\\|function\\)")
 652 (defconst f90-else-like-re
 653   "\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\)")
 654 (defconst f90-end-if-re
 655   "end[ \t]*\\(if\\|select\\|where\\|forall\\)\\>")
 656 (defconst f90-end-type-re
 657   "end[ \t]*\\(type\\|interface\\|block[ \t]*data\\)")
 658 (defconst f90-type-def-re
 659   "\\<\\(type\\)\\([^(\n]*\\)\\(::\\)?[ \t]*\\b\\(\\sw+\\)")
 660 (defconst f90-no-break-re  "\\(\\*\\*\\|//\\|=>\\)")
 661 ;; A temporary position to make region operators faster
 662 (defvar f90-cache-position nil)
 663 (make-variable-buffer-local 'f90-cache-position)
 664 ;; A flag to tell whether f90-imenu is turned on.
 665 (defvar f90-imenu nil)
 666 (make-variable-buffer-local 'f90-imenu)
 667
 668 \f
 669 ;; Imenu support
 670 (defvar f90-imenu-generic-expression
 671   (let ((good-char "[^!\"\&\n \t]") (not-e "[^e!\n\"\& \t]")
 672         (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]"))
 673     (list
 674      '(nil "^[ \t0-9]*program[ \t]+\\(\\sw+\\)" 1)
 675      '("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1)
 676      '("Types" "^[ \t0-9]*type[ \t]+\\(\\sw+\\)" 1)
 677      (list
 678       "Procedures"
 679       (concat
 680        "^[ \t0-9]*"
 681        "\\("
 682        ;; At least three non-space characters before function/subroutine
 683        ;; Check that the last three non-space characters don't spell E N D
 684        "[^!\"\&\n]*\\("
 685        not-e good-char good-char "\\|"
 686        good-char not-n good-char "\\|"
 687        good-char good-char not-d "\\)"
 688        "\\|"
 689        ;; Less than three non-space characters before function/subroutine
 690        good-char "?" good-char "?"
 691        "\\)"
 692        "[ \t]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)")
 693     4)))
 694   "imenu generic expression for F90 mode.")
 695
 696 (defun f90-add-imenu-menu ()
 697   (interactive)
 698   "Add an imenu menu to the menubar."
 699   (if (not f90-imenu)
 700       (progn
 701         (imenu-add-to-menubar "F90-imenu")
 702         (redraw-frame (selected-frame))
 703         (setq f90-imenu t))
 704     (message "%s" "F90-imenu already exists.")))
 705 (put 'f90-add-imenu-menu 'menu-enable '(not f90-imenu))
 706
 707
 708 ;; When compiling under GNU Emacs, load imenu during compilation.  If
 709 ;; you have 19.22 or earlier, comment this out, or get imenu.
 710 (and (fboundp 'eval-when-compile)
 711      (eval-when-compile
 712        (if (not (string-match "XEmacs" emacs-version))
 713            (require 'imenu))
 714        ()))
 715 \f
 716 ;; abbrevs have generally two letters, except standard types `c, `i, `r, `t
 717 (defvar f90-mode-abbrev-table nil)
 718 (if f90-mode-abbrev-table
 719     ()
 720   (let ((ac abbrevs-changed))
 721     (define-abbrev-table 'f90-mode-abbrev-table ())
 722     (define-abbrev f90-mode-abbrev-table  "`al"  "allocate" nil)
 723     (define-abbrev f90-mode-abbrev-table  "`ab"  "allocatable" nil)
 724     (define-abbrev f90-mode-abbrev-table  "`as"  "assignment" nil)
 725     (define-abbrev f90-mode-abbrev-table  "`ba"  "backspace" nil)
 726     (define-abbrev f90-mode-abbrev-table  "`bd"  "block data" nil)
 727     (define-abbrev f90-mode-abbrev-table  "`c"   "character" nil)
 728     (define-abbrev f90-mode-abbrev-table  "`cl"  "close" nil)
 729     (define-abbrev f90-mode-abbrev-table  "`cm"  "common" nil)
 730     (define-abbrev f90-mode-abbrev-table  "`cx"  "complex" nil)
 731     (define-abbrev f90-mode-abbrev-table  "`cn"  "contains" nil)
 732     (define-abbrev f90-mode-abbrev-table  "`cy"  "cycle" nil)
 733     (define-abbrev f90-mode-abbrev-table  "`de"  "deallocate" nil)
 734     (define-abbrev f90-mode-abbrev-table  "`df"  "define" nil)
 735     (define-abbrev f90-mode-abbrev-table  "`di"  "dimension" nil)
 736     (define-abbrev f90-mode-abbrev-table  "`dw"  "do while" nil)
 737     (define-abbrev f90-mode-abbrev-table  "`el"  "else" nil)
 738     (define-abbrev f90-mode-abbrev-table  "`eli" "else if" nil)
 739     (define-abbrev f90-mode-abbrev-table  "`elw" "elsewhere" nil)
 740     (define-abbrev f90-mode-abbrev-table  "`eq"  "equivalence" nil)
 741     (define-abbrev f90-mode-abbrev-table  "`ex"  "external" nil)
 742     (define-abbrev f90-mode-abbrev-table  "`ey"  "entry" nil)
 743     (define-abbrev f90-mode-abbrev-table  "`fl"  "forall" nil)
 744     (define-abbrev f90-mode-abbrev-table  "`fo"  "format" nil)
 745     (define-abbrev f90-mode-abbrev-table  "`fu"  "function" nil)
 746     (define-abbrev f90-mode-abbrev-table  "`fa"  ".false." nil)
 747     (define-abbrev f90-mode-abbrev-table  "`im"  "implicit none" nil)
 748     (define-abbrev f90-mode-abbrev-table  "`in " "include" nil)
 749     (define-abbrev f90-mode-abbrev-table  "`i"   "integer" nil)
 750     (define-abbrev f90-mode-abbrev-table  "`it"  "intent" nil)
 751     (define-abbrev f90-mode-abbrev-table  "`if"  "interface" nil)
 752     (define-abbrev f90-mode-abbrev-table  "`lo"  "logical" nil)
 753     (define-abbrev f90-mode-abbrev-table  "`mo"  "module" nil)
 754     (define-abbrev f90-mode-abbrev-table  "`na"  "namelist" nil)
 755     (define-abbrev f90-mode-abbrev-table  "`nu"  "nullify" nil)
 756     (define-abbrev f90-mode-abbrev-table  "`op"  "optional" nil)
 757     (define-abbrev f90-mode-abbrev-table  "`pa"  "parameter" nil)
 758     (define-abbrev f90-mode-abbrev-table  "`po"  "pointer" nil)
 759     (define-abbrev f90-mode-abbrev-table  "`pr"  "print" nil)
 760     (define-abbrev f90-mode-abbrev-table  "`pi"  "private" nil)
 761     (define-abbrev f90-mode-abbrev-table  "`pm"  "program" nil)
 762     (define-abbrev f90-mode-abbrev-table  "`pu"  "public" nil)
 763     (define-abbrev f90-mode-abbrev-table  "`r"   "real" nil)
 764     (define-abbrev f90-mode-abbrev-table  "`rc"  "recursive" nil)
 765     (define-abbrev f90-mode-abbrev-table  "`rt"  "return" nil)
 766     (define-abbrev f90-mode-abbrev-table  "`rw"  "rewind" nil)
 767     (define-abbrev f90-mode-abbrev-table  "`se"  "select" nil)
 768     (define-abbrev f90-mode-abbrev-table  "`sq"  "sequence" nil)
 769     (define-abbrev f90-mode-abbrev-table  "`su"  "subroutine" nil)
 770     (define-abbrev f90-mode-abbrev-table  "`ta"  "target" nil)
 771     (define-abbrev f90-mode-abbrev-table  "`tr"  ".true." nil)
 772     (define-abbrev f90-mode-abbrev-table  "`t"   "type" nil)
 773     (define-abbrev f90-mode-abbrev-table  "`wh"  "where" nil)
 774     (define-abbrev f90-mode-abbrev-table  "`wr"  "write" nil)
 775     (setq abbrevs-changed ac)))
 776 \f
 777 ;;;###autoload
 778 (defun f90-mode ()
 779   "Major mode for editing Fortran 90 code in free format.
 780
 781 \\[f90-indent-new-line] corrects current indentation and creates new\
 782  indented line.
 783 \\[f90-indent-line] indents the current line correctly.
 784 \\[f90-indent-subprogram] indents the current subprogram.
 785
 786 Type `? or `\\[help-command] to display a list of built-in\
 787  abbrevs for F90 keywords.
 788
 789 Key definitions:
 790 \\{f90-mode-map}
 791
 792 Variables controlling indentation style and extra features:
 793
 794  f90-do-indent
 795     Extra indentation within do blocks.  (default 3)
 796  f90-if-indent
 797     Extra indentation within if/select case/where/forall blocks. (default 3)
 798  f90-type-indent
 799     Extra indentation within type/interface/block-data blocks.  (default 3)
 800  f90-program-indent
 801     Extra indentation within program/module/subroutine/function blocks.
 802       (default 2)
 803  f90-continuation-indent
 804     Extra indentation applied to continuation lines.  (default 5)
 805  f90-comment-region
 806     String inserted by \\[f90-comment-region] at start of each line in
 807     region.  (default \"!!!$\")
 808  f90-indented-comment-re
 809     Regexp determining the type of comment to be intended like code.
 810     (default \"!\")
 811  f90-directive-comment-re
 812     Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented.
 813     (default \"!hpf\\\\$\")
 814  f90-break-delimiters
 815     Regexp holding list of delimiters at which lines may be broken.
 816     (default \"[-+*/><=,% \\t]\")
 817  f90-break-before-delimiters
 818     Non-nil causes `f90-do-auto-fill' to break lines before delimiters.
 819     (default t)
 820  f90-beginning-ampersand
 821     Automatic insertion of \& at beginning of continuation lines. (default t)
 822  f90-smart-end
 823     From an END statement, check and fill the end using matching block start.
 824     Allowed values are 'blink, 'no-blink, and nil, which determine
 825     whether to blink the matching beginning.) (default 'blink)
 826  f90-auto-keyword-case
 827     Automatic change of case of keywords. (default nil)
 828     The possibilities are 'downcase-word, 'upcase-word, 'capitalize-word.
 829  f90-leave-line-no
 830     Do not left-justify line numbers. (default nil)
 831  f90-startup-message
 832     Set to nil to inhibit message first time F90 mode is used. (default t)
 833  f90-keywords-re
 834     List of keywords used for highlighting/upcase-keywords etc.
 835
 836 Turning on F90 mode calls the value of the variable `f90-mode-hook'
 837 with no args, if that value is non-nil."
 838   (interactive)
 839   (kill-all-local-variables)
 840   (setq major-mode 'f90-mode)
 841   (setq mode-name "F90")
 842   (setq local-abbrev-table f90-mode-abbrev-table)
 843   (set-syntax-table f90-mode-syntax-table)
 844   (use-local-map f90-mode-map)
 845   (make-local-variable 'indent-line-function)
 846   (setq indent-line-function 'f90-indent-line)
 847   (make-local-variable 'indent-region-function)
 848   (setq indent-region-function 'f90-indent-region)
 849   (make-local-variable 'require-final-newline)
 850   (setq require-final-newline t)
 851   (make-local-variable 'comment-start)
 852   (setq comment-start "!")
 853   (make-local-variable 'comment-start-skip)
 854   (setq comment-start-skip "!+ *")
 855   (make-local-variable 'comment-indent-function)
 856   (setq comment-indent-function 'f90-comment-indent)
 857   (make-local-variable 'abbrev-all-caps)
 858   (setq abbrev-all-caps t)
 859   (make-local-variable 'normal-auto-fill-function)
 860   (setq normal-auto-fill-function 'f90-do-auto-fill)
 861   (setq indent-tabs-mode nil)
 862   ;; Setting up things for font-lock
 863   (if (string-match "XEmacs" emacs-version)
 864       (progn
 865         (put 'f90-mode 'font-lock-keywords-case-fold-search t)
 866         (if (and (featurep 'menubar)
 867                  current-menubar
 868                  (not (assoc "F90" current-menubar)))
 869             (progn
 870               (set-buffer-menubar (copy-sequence current-menubar))
 871               (add-submenu nil f90-xemacs-menu)))))
 872   ;; XEmacs: (Don't need a special case, since both emacsen work alike -sb)
 873   (make-local-variable 'font-lock-defaults)
 874   (setq font-lock-defaults
 875         '((f90-font-lock-keywords f90-font-lock-keywords-1
 876                                   f90-font-lock-keywords-2
 877                                   f90-font-lock-keywords-3
 878                                   f90-font-lock-keywords-4)
 879           nil t))
 880   ;; Tell imenu how to handle f90.
 881   (set (make-local-variable 'imenu-case-fold-search) t)
 882   (make-local-variable 'imenu-generic-expression)
 883   (setq imenu-generic-expression f90-imenu-generic-expression)
 884   (run-hooks 'f90-mode-hook)
 885   (if f90-startup-message
 886       (message "Emacs F90 mode; please report bugs to %s" bug-f90-mode))
 887   (setq f90-startup-message nil))
 888 \f
 889 ;; inline-functions
 890 (defsubst f90-get-beg-of-line ()
 891   (save-excursion (beginning-of-line) (point)))
 892
 893 (defsubst f90-get-end-of-line ()
 894   (save-excursion (end-of-line) (point)))
 895
 896 (defsubst f90-in-string ()
 897   (let ((beg-pnt
 898          (if (and f90-cache-position (> (point) f90-cache-position))
 899              f90-cache-position
 900            (point-min))))
 901     (nth 3 (parse-partial-sexp beg-pnt (point)))))
 902
 903 (defsubst f90-in-comment ()
 904   (let ((beg-pnt
 905          (if (and f90-cache-position (> (point) f90-cache-position))
 906              f90-cache-position
 907            (point-min))))
 908     (nth 4 (parse-partial-sexp beg-pnt (point)))))
 909
 910 (defsubst f90-line-continued ()
 911   (save-excursion
 912     (let ((bol (f90-get-beg-of-line)))
 913       (end-of-line)
 914       (while (f90-in-comment)
 915         (search-backward "!" bol)
 916         (skip-chars-backward "!"))
 917       (skip-chars-backward " \t")
 918       (= (preceding-char) ?&))))
 919
 920 (defsubst f90-current-indentation ()
 921   "Return indentation of current line.
 922 Line-numbers are considered whitespace characters."
 923   (save-excursion
 924     (beginning-of-line) (skip-chars-forward " \t0-9")
 925     (current-column)))
 926
 927 (defsubst f90-indent-to (col &optional no-line-number)
 928   "Indent current line to column COL.
 929 If no-line-number nil, jump over a possible line-number."
 930   (beginning-of-line)
 931   (if (not no-line-number)
 932       (skip-chars-forward " \t0-9"))
 933   (delete-horizontal-space)
 934   (if (zerop (current-column))
 935       (indent-to col)
 936     (indent-to col 1)))
 937
 938 (defsubst f90-match-piece (arg)
 939   (if (match-beginning arg)
 940       (buffer-substring (match-beginning arg) (match-end arg))))
 941
 942 (defsubst f90-get-present-comment-type ()
 943   (save-excursion
 944     (let ((type nil) (eol (f90-get-end-of-line)))
 945       (if (f90-in-comment)
 946           (progn
 947             (beginning-of-line)
 948             (re-search-forward "[!]+" eol)
 949             (while (f90-in-string)
 950               (re-search-forward "[!]+" eol))
 951             (setq type (buffer-substring (match-beginning 0) (match-end 0)))))
 952       type)))
 953
 954 (defsubst f90-equal-symbols (a b)
 955   "Compare strings neglecting case and allowing for nil value."
 956   (let ((a-local (if a (downcase a) nil))
 957         (b-local (if b (downcase b) nil)))
 958     (equal a-local b-local)))
 959
 960 ;; XEmacs 19.11 & 19.12 gives back a single char when matching an empty regular
 961 ;; expression. Therefore, the next 2 functions are longer than necessary.
 962
 963 (defsubst f90-looking-at-do ()
 964   "Return (\"do\" name) if a do statement starts after point.
 965 Name is nil if the statement has no label."
 966   (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(do\\)\\>")
 967       (let (label
 968             (struct (f90-match-piece 3)))
 969         (if (looking-at "\\(\\sw+\\)[ \t]*\:")
 970             (setq label (f90-match-piece 1)))
 971         (list struct label))))
 972
 973 (defsubst f90-looking-at-select-case ()
 974   "Return (\"select\" name) if a select-case statement starts after point.
 975 Name is nil if the statement has no label."
 976   (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(select\\)[ \t]*case[ \t]*(")
 977       (let (label
 978             (struct (f90-match-piece 3)))
 979         (if (looking-at "\\(\\sw+\\)[ \t]*\:")
 980             (setq label (f90-match-piece 1)))
 981         (list struct label))))
 982
 983 (defsubst f90-looking-at-if-then ()
 984   "Return (\"if\" name) if an if () then statement starts after point.
 985 Name is nil if the statement has no label."
 986   (save-excursion
 987     (let (struct (label nil))
 988       (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>")
 989           (progn
 990             (setq struct (f90-match-piece 3))
 991             (if (looking-at "\\(\\sw+\\)[ \t]*\:")
 992                 (setq label (f90-match-piece 1)))
 993             (let ((pos (scan-lists (point) 1 0)))
 994               (and pos (goto-char pos)))
 995             (skip-chars-forward " \t")
 996             (if (or (looking-at "then\\>")
 997                     (if (f90-line-continued)
 998                         (progn
 999                           (f90-next-statement)
1000                           (skip-chars-forward " \t0-9&")
1001                           (looking-at "then\\>"))))
1002                 (list struct label)))))))
1003
1004 (defsubst f90-looking-at-where-or-forall ()
1005   "Return (kind name) if a where or forall block starts after point.
1006 Name is nil if the statement has no label."
1007   (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)")
1008       (let (label
1009             (struct (f90-match-piece 3)))
1010         (if (looking-at "\\(\\sw+\\)[ \t]*\:")
1011             (setq label (f90-match-piece 1)))
1012         (list struct label))))
1013
1014 (defsubst f90-looking-at-type-like ()
1015   "Return (kind name) at the start of a type/interface/block-data block.
1016 Name is non-nil only for type."
1017   (cond
1018    ((looking-at f90-type-def-re)
1019     (list (f90-match-piece 1) (f90-match-piece 4)))
1020    ((looking-at "\\(interface\\|block[\t]*data\\)\\>")
1021     (list (f90-match-piece 1) nil))))
1022
1023 (defsubst f90-looking-at-program-block-start ()
1024   "Return (kind name) if a program block with name name starts after point."
1025   (cond
1026    ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>")
1027     (list (f90-match-piece 1) (f90-match-piece 2)))
1028    ((and (not (looking-at "module[ \t]*procedure\\>"))
1029          (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>"))
1030     (list (f90-match-piece 1) (f90-match-piece 2)))
1031    ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)"))
1032          (looking-at "[^!\"\&\n]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)"))
1033     (list (f90-match-piece 1) (f90-match-piece 2)))))
1034
1035 (defsubst f90-looking-at-program-block-end ()
1036   "Return list of type and name of end of block."
1037   (if (looking-at (concat "end[ \t]*" f90-blocks-re
1038                           "?\\([ \t]+\\(\\sw+\\)\\)?\\>"))
1039       (list (f90-match-piece 1) (f90-match-piece 3))))
1040
1041 (defsubst f90-comment-indent ()
1042   (cond ((looking-at "!!!") 0)
1043         ((and f90-directive-comment-re
1044               (looking-at f90-directive-comment-re)) 0)
1045         ((looking-at (regexp-quote f90-comment-region)) 0)
1046         ((and (looking-at f90-indented-comment-re)
1047               ;; Don't attempt to indent trailing comment as code.
1048               (save-excursion
1049                 (skip-chars-backward " \t")
1050                 (bolp)))
1051          (f90-calculate-indent))
1052         (t (skip-chars-backward " \t")
1053            (max (if (bolp) 0 (1+ (current-column))) comment-column))))
1054
1055 (defsubst f90-present-statement-cont ()
1056   "Return continuation properties of present statement."
1057   (let (pcont cont)
1058     (save-excursion
1059       (setq pcont (if (f90-previous-statement) (f90-line-continued) nil)))
1060     (setq cont (f90-line-continued))
1061     (cond ((and (not pcont) (not cont)) 'single)
1062           ((and (not pcont) cont)       'begin)
1063           ((and pcont       (not cont)) 'end)
1064           ((and pcont       cont)       'middle)
1065           (t (error)))))
1066
1067 (defsubst f90-indent-line-no ()
1068   (if f90-leave-line-no
1069       ()
1070     (if (and (not (zerop (skip-chars-forward " \t")))
1071              (looking-at "[0-9]"))
1072         (delete-horizontal-space)))
1073   (skip-chars-forward " \t0-9"))
1074
1075 (defsubst f90-no-block-limit ()
1076   (let ((eol (f90-get-end-of-line)))
1077     (save-excursion
1078       (not (or (looking-at "end")
1079                (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\
1080 \\|select[ \t]*case\\|case\\|where\\|forall\\)\\>")
1081                (looking-at "\\(program\\|module\\|interface\\|\
1082 block[ \t]*data\\)\\>")
1083                (looking-at "\\(contains\\|\\sw+[ \t]*:\\)")
1084                (looking-at f90-type-def-re)
1085                (re-search-forward "\\(function\\|subroutine\\)" eol t))))))
1086
1087 (defsubst f90-update-line ()
1088   (let (bol eol)
1089     (if f90-auto-keyword-case
1090         (progn (setq bol (f90-get-beg-of-line)
1091                      eol (f90-get-end-of-line))
1092                (if f90-auto-keyword-case
1093                    (f90-change-keywords f90-auto-keyword-case bol eol))))))
1094 \f
1095 (defun f90-electric-insert ()
1096   (interactive)
1097   "Calls f90-do-auto-fill at each operator insertion."
1098   (self-insert-command 1)
1099   (f90-update-line)
1100   (if auto-fill-function (f90-do-auto-fill)))
1101
1102 (defun f90-get-correct-indent ()
1103   "Get correct indent for a line starting with line number.
1104 Does not check type and subprogram indentation."
1105   (let ((epnt (f90-get-end-of-line)) icol cont)
1106     (save-excursion
1107       (while (and (f90-previous-statement)
1108                   (or (progn
1109                         (setq cont (f90-present-statement-cont))
1110                         (or (eq cont 'end) (eq cont 'middle)))
1111                       (looking-at "[ \t]*[0-9]"))))
1112       (setq icol (current-indentation))
1113       (beginning-of-line)
1114       (if (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)"
1115                              (f90-get-end-of-line) t)
1116           (progn
1117             (beginning-of-line) (skip-chars-forward " \t")
1118             (cond ((f90-looking-at-do)
1119                    (setq icol (+ icol f90-do-indent)))
1120                   ((or (f90-looking-at-if-then)
1121                        (f90-looking-at-where-or-forall)
1122                        (f90-looking-at-select-case))
1123                    (setq icol (+ icol f90-if-indent))))
1124             (end-of-line)))
1125       (while (re-search-forward
1126               "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t)
1127         (beginning-of-line) (skip-chars-forward " \t0-9")
1128         (cond  ((f90-looking-at-do)
1129                 (setq icol (+ icol f90-do-indent)))
1130                ((or (f90-looking-at-if-then)
1131                     (f90-looking-at-where-or-forall)
1132                     (f90-looking-at-select-case))
1133                 (setq icol (+ icol f90-if-indent)))
1134                ((looking-at f90-end-if-re)
1135                 (setq icol (- icol f90-if-indent)))
1136                ((looking-at "end[ \t]*do\\>")
1137                 (setq icol (- icol f90-do-indent))))
1138         (end-of-line))
1139       icol)))
1140
1141
1142 (defun f90-calculate-indent ()
1143   "Calculate the indent column based on previous statements."
1144   (interactive)
1145   (let (icol cont (case-fold-search t) (pnt (point)))
1146     (save-excursion
1147       (if (not (f90-previous-statement))
1148           (setq icol 0)
1149         (setq cont (f90-present-statement-cont))
1150         (if (eq cont 'end)
1151             (while (not (eq 'begin (f90-present-statement-cont)))
1152               (f90-previous-statement)))
1153         (cond ((eq cont 'begin)
1154                (setq icol (+ (f90-current-indentation)
1155                              f90-continuation-indent)))
1156               ((eq cont 'middle) (setq icol(current-indentation)))
1157               (t (setq icol (f90-current-indentation))
1158                  (skip-chars-forward " \t")
1159                  (if (looking-at "[0-9]")
1160                      (setq icol (f90-get-correct-indent))
1161                    (cond ((or (f90-looking-at-if-then)
1162                               (f90-looking-at-where-or-forall)
1163                               (f90-looking-at-select-case)
1164                               (looking-at f90-else-like-re))
1165                           (setq icol (+ icol f90-if-indent)))
1166                          ((f90-looking-at-do)
1167                           (setq icol (+ icol f90-do-indent)))
1168                          ((f90-looking-at-type-like)
1169                           (setq icol (+ icol f90-type-indent)))
1170                          ((or (f90-looking-at-program-block-start)
1171                               (looking-at "contains[ \t]*\\($\\|!\\)"))
1172                           (setq icol (+ icol f90-program-indent)))))
1173                  (goto-char pnt)
1174                  (beginning-of-line)
1175                  (cond ((looking-at "[ \t]*$"))
1176                        ((looking-at "[ \t]*#") ; Check for cpp directive.
1177                         (setq icol 0))
1178                        (t
1179                         (skip-chars-forward " \t0-9")
1180                         (cond ((or (looking-at f90-else-like-re)
1181                                    (looking-at f90-end-if-re))
1182                                (setq icol (- icol f90-if-indent)))
1183                               ((looking-at "end[ \t]*do\\>")
1184                                (setq icol (- icol f90-do-indent)))
1185                               ((looking-at f90-end-type-re)
1186                                (setq icol (- icol f90-type-indent)))
1187                               ((or (looking-at "contains[ \t]*\\(!\\|$\\)")
1188                                    (f90-looking-at-program-block-end))
1189                                (setq icol (- icol f90-program-indent))))))
1190                  ))))
1191     icol))
1192 \f
1193 ;; Statement = statement line, a line which is neither blank, nor a comment.
1194 (defun f90-previous-statement ()
1195   "Move point to beginning of the previous F90 statement.
1196 Return nil if no previous statement is found."
1197   (interactive)
1198   (let (not-first-statement)
1199     (beginning-of-line)
1200     (while (and (setq not-first-statement (zerop (forward-line -1)))
1201                 (looking-at "[ \t0-9]*\\(!\\|$\\|#\\)")))
1202     not-first-statement))
1203
1204 (defun f90-next-statement ()
1205   "Move point to beginning of the next F90 statement.
1206 Return nil if no later statement is found."
1207   (interactive)
1208   (let (not-last-statement)
1209     (beginning-of-line)
1210     (while (and (setq not-last-statement
1211                       (and (zerop (forward-line 1))
1212                            (not (eobp))))
1213                 (looking-at "[ \t0-9]*\\(!\\|$\\)")))
1214     not-last-statement))
1215
1216 (defun f90-beginning-of-subprogram ()
1217   "Move point to the beginning of subprogram.
1218 Return (type name) or nil if not found."
1219   (interactive)
1220   (let ((count 1) (case-fold-search t) matching-beg)
1221     (beginning-of-line) (skip-chars-forward " \t0-9")
1222     (if (setq matching-beg (f90-looking-at-program-block-start))
1223         (setq count (- count 1)))
1224     (while (and (not (zerop count))
1225                 (re-search-backward f90-program-block-re nil 'move))
1226       (beginning-of-line) (skip-chars-forward " \t0-9")
1227       (cond
1228        ((setq matching-beg (f90-looking-at-program-block-start))
1229         (setq count (- count 1)))
1230        ((f90-looking-at-program-block-end)
1231         (setq count (+ count 1)))))
1232     (beginning-of-line)
1233     (if (zerop count)
1234         matching-beg
1235       (message "No beginning-found.")
1236       nil)))
1237
1238 (defun f90-end-of-subprogram ()
1239   "Move point to the end of subprogram.
1240 Return (type name) or nil if not found."
1241   (interactive)
1242   (let ((count 1) (case-fold-search t) matching-end)
1243     (beginning-of-line) (skip-chars-forward " \t0-9")
1244     (if (setq matching-end (f90-looking-at-program-block-end))
1245         (setq count (1- count)))
1246     (end-of-line)
1247     (while (and (not (zerop count))
1248                 (re-search-forward f90-program-block-re nil 'move))
1249       (beginning-of-line) (skip-chars-forward " \t0-9")
1250       (cond ((f90-looking-at-program-block-start)
1251              (setq count (+ count 1)))
1252             ((setq matching-end (f90-looking-at-program-block-end))
1253              (setq count (1- count ))))
1254       (end-of-line))
1255     (forward-line 1)
1256     (if (zerop count)
1257         matching-end
1258       (message "No end found.")
1259       nil)))
1260
1261 (defun f90-mark-subprogram ()
1262   "Put mark at end of F90 subprogram, point at beginning.
1263 Marks are pushed and highlight (grey shadow) is turned on."
1264   (interactive)
1265   (let ((pos (point)) program)
1266     (f90-end-of-subprogram)
1267     (push-mark (point) t)
1268     (goto-char pos)
1269     (setq program (f90-beginning-of-subprogram))
1270     ;; The keywords in the preceding lists assume case-insensitivity.
1271     (if (string-match "XEmacs" emacs-version)
1272         (zmacs-activate-region)
1273       (setq mark-active t)
1274       (setq deactivate-mark nil))
1275     program))
1276
1277 (defun f90-comment-region (beg-region end-region)
1278   "Comment/uncomment every line in the region.
1279 Insert f90-comment-region at the beginning of every line in the region
1280 or, if already present, remove it."
1281   (interactive "*r")
1282   (let ((end (make-marker)))
1283     (set-marker end end-region)
1284     (goto-char beg-region)
1285     (beginning-of-line)
1286     (if (looking-at (regexp-quote f90-comment-region))
1287         (delete-region (point) (match-end 0))
1288       (insert f90-comment-region))
1289     (while (and  (zerop (forward-line 1))
1290                  (< (point) (marker-position end)))
1291       (if (looking-at (regexp-quote f90-comment-region))
1292           (delete-region (point) (match-end 0))
1293         (insert f90-comment-region)))
1294     (set-marker end nil)))
1295
1296 (defun f90-indent-line (&optional no-update)
1297   "Indent current line as F90 code."
1298   (interactive)
1299   (let (indent (no-line-number nil) (pos (make-marker)) (case-fold-search t))
1300     (set-marker pos (point))
1301     (beginning-of-line)                 ; Digits after & \n are not line-no
1302     (if (save-excursion (and (f90-previous-statement) (f90-line-continued)))
1303         (progn (setq no-line-number t) (skip-chars-forward " \t"))
1304       (f90-indent-line-no))
1305     (if (looking-at "!")
1306         (setq indent (f90-comment-indent))
1307       (if (and (looking-at "end") f90-smart-end)
1308             (f90-match-end))
1309       (setq indent (f90-calculate-indent)))
1310     (if (zerop (- indent (current-column)))
1311         nil
1312       (f90-indent-to indent no-line-number))
1313     ;; If initial point was within line's indentation,
1314     ;; position after the indentation.  Else stay at same point in text.
1315     (if (< (point) (marker-position pos))
1316         (goto-char (marker-position pos)))
1317     (if (not no-update) (f90-update-line))
1318     (if auto-fill-function (f90-do-auto-fill))
1319     (set-marker pos nil)))
1320
1321 (defun f90-indent-new-line ()
1322   "Reindent the current F90 line, insert a newline and indent the newline.
1323 An abbrev before point is expanded if `abbrev-mode' is non-nil.
1324 If run in the middle of a line, the line is not broken."
1325   (interactive)
1326   (let (string cont (case-fold-search t))
1327     (if abbrev-mode (expand-abbrev))
1328     (beginning-of-line)                 ; Reindent where likely to be needed.
1329     (f90-indent-line-no)
1330     (if (or (looking-at "\\(end\\|else\\|!\\)"))
1331         (f90-indent-line 'no-update))
1332     (end-of-line)
1333     (delete-horizontal-space)           ;Destroy trailing whitespace
1334     (setq string (f90-in-string))
1335     (setq cont (f90-line-continued))
1336     (if (and string (not cont)) (insert "&"))
1337     (f90-update-line)
1338     (newline)
1339     (if (or string (and cont f90-beginning-ampersand)) (insert "&"))
1340     (f90-indent-line 'no-update)))
1341
1342
1343 (defun f90-indent-region (beg-region end-region)
1344   "Indent every line in region by forward parsing."
1345   (interactive "*r")
1346   (let ((end-region-mark (make-marker)) (save-point (point-marker))
1347         (block-list nil) ind-lev ind-curr ind-b cont
1348         struct beg-struct end-struct)
1349     (set-marker end-region-mark end-region)
1350     (goto-char beg-region)
1351     ;; first find a line which is not a continuation line or comment
1352     (beginning-of-line)
1353     (while (and (looking-at "[ \t]*[0-9]*\\(!\\|#\\|[ \t]*$\\)")
1354                 (progn (f90-indent-line 'no-update)
1355                        (zerop (forward-line 1)))
1356                 (< (point) end-region-mark)))
1357     (setq cont (f90-present-statement-cont))
1358     (while (and (or (eq cont 'middle) (eq cont 'end))
1359                 (f90-previous-statement))
1360       (setq cont (f90-present-statement-cont)))
1361     ;; process present line for beginning of block
1362     (setq f90-cache-position (point))
1363     (f90-indent-line 'no-update)
1364     (setq ind-lev (f90-current-indentation))
1365     (setq ind-curr ind-lev)
1366     (beginning-of-line) (skip-chars-forward " \t0-9")
1367     (setq struct nil)
1368     (setq ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent)
1369                       ((or (setq struct (f90-looking-at-if-then))
1370                            (setq struct (f90-looking-at-select-case))
1371                            (setq struct (f90-looking-at-where-or-forall))
1372                            (looking-at f90-else-like-re))
1373                        f90-if-indent)
1374                       ((setq struct (f90-looking-at-type-like))
1375                        f90-type-indent)
1376                       ((or(setq struct (f90-looking-at-program-block-start))
1377                           (looking-at "contains[ \t]*\\($\\|!\\)"))
1378                        f90-program-indent)))
1379     (if ind-b (setq ind-lev (+ ind-lev ind-b)))
1380     (if struct (setq block-list (cons struct block-list)))
1381     (while (and (f90-line-continued) (zerop (forward-line 1))
1382                 (< (point) end-region-mark))
1383       (if (not (zerop (- (current-indentation)
1384                          (+ ind-curr f90-continuation-indent))))
1385           (f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no)))
1386     ;; process all following lines
1387     (while (and  (zerop (forward-line 1)) (< (point) end-region-mark))
1388       (beginning-of-line)
1389       (f90-indent-line-no)
1390       (setq f90-cache-position (point))
1391       (cond ((looking-at "[ \t]*$") (setq ind-curr 0))
1392             ((looking-at "[ \t]*#") (setq ind-curr 0))
1393             ((looking-at "!") (setq ind-curr (f90-comment-indent)))
1394             ((f90-no-block-limit) (setq ind-curr ind-lev))
1395             ((looking-at f90-else-like-re) (setq ind-curr
1396                                                  (- ind-lev f90-if-indent)))
1397             ((looking-at "contains[ \t]*\\($\\|!\\)")
1398              (setq ind-curr (- ind-lev f90-program-indent)))
1399             ((setq ind-b
1400                    (cond ((setq struct (f90-looking-at-do)) f90-do-indent)
1401                          ((or (setq struct (f90-looking-at-if-then))
1402                               (setq struct (f90-looking-at-select-case))
1403                               (setq struct (f90-looking-at-where-or-forall)))
1404                           f90-if-indent)
1405                          ((setq struct (f90-looking-at-type-like))
1406                           f90-type-indent)
1407                          ((setq struct (f90-looking-at-program-block-start))
1408                           f90-program-indent)))
1409              (setq ind-curr ind-lev)
1410              (if ind-b (setq ind-lev (+ ind-lev ind-b)))
1411              (setq block-list (cons struct block-list)))
1412             ((setq end-struct (f90-looking-at-program-block-end))
1413              (setq beg-struct (car block-list)
1414                    block-list (cdr block-list))
1415              (if f90-smart-end
1416                  (save-excursion
1417                    (f90-block-match (car beg-struct)(car (cdr beg-struct))
1418                                     (car end-struct)(car (cdr end-struct)))))
1419              (setq ind-b
1420                    (cond ((looking-at f90-end-if-re) f90-if-indent)
1421                          ((looking-at "end[ \t]*do\\>")  f90-do-indent)
1422                          ((looking-at f90-end-type-re) f90-type-indent)
1423                          ((f90-looking-at-program-block-end)
1424                           f90-program-indent)))
1425              (if ind-b (setq ind-lev (- ind-lev ind-b)))
1426              (setq ind-curr ind-lev))
1427             (t (setq ind-curr ind-lev)))
1428       ;; do the indentation if necessary
1429       (if (not (zerop (- ind-curr (current-column))))
1430           (f90-indent-to ind-curr))
1431       (while (and (f90-line-continued) (zerop (forward-line 1))
1432                   (< (point) end-region-mark))
1433         (if (not (zerop (- (current-indentation)
1434                            (+ ind-curr f90-continuation-indent))))
1435             (f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no))))
1436     ;; restore point etc
1437     (setq f90-cache-position nil)
1438     (goto-char save-point)
1439     (set-marker end-region-mark nil)
1440     (set-marker save-point nil)
1441     (if (string-match "XEmacs" emacs-version)
1442         (zmacs-deactivate-region)
1443       (deactivate-mark))))
1444
1445 (defun f90-indent-subprogram ()
1446   "Properly indent the subprogram which contains point."
1447   (interactive)
1448   (save-excursion
1449     (let (program)
1450       (setq program (f90-mark-subprogram))
1451       (if program
1452           (progn
1453             (message "Indenting %s %s..."
1454                      (car program) (car (cdr program)))
1455             (f90-indent-region (point) (mark))
1456             (message "Indenting %s %s...done"
1457                      (car program) (car (cdr program))))
1458         (message "Indenting the whole file...")
1459         (f90-indent-region (point) (mark))
1460         (message "Indenting the whole file...done")))))
1461
1462 ;; autofill and break-line
1463 (defun f90-break-line (&optional no-update)
1464   "Break line at point, insert continuation marker(s) and indent."
1465   (interactive)
1466   (let (ctype)
1467     (cond ((f90-in-string)
1468            (insert "&") (newline) (insert "&"))
1469           ((f90-in-comment)
1470            (setq ctype (f90-get-present-comment-type))
1471            (newline)
1472            (insert ctype))
1473           (t (insert "&")
1474              (if (not no-update) (f90-update-line))
1475              (newline)
1476              (if f90-beginning-ampersand (insert "&")))))
1477   (f90-indent-line))
1478
1479 (defun f90-find-breakpoint ()
1480   "From fill-column, search backward for break-delimiter."
1481   (let ((bol (f90-get-beg-of-line)))
1482     (re-search-backward f90-break-delimiters bol)
1483     (if f90-break-before-delimiters
1484         (progn (backward-char)
1485                (if (not (looking-at f90-no-break-re))
1486                    (forward-char)))
1487       (if (looking-at f90-no-break-re)
1488           (forward-char 2)
1489         (forward-char)))))
1490
1491 (defun f90-do-auto-fill ()
1492   "Break line if non-white characters beyond fill-column. Also, update line. "
1493   (interactive)
1494   ;; Break the line before or after the last delimiter (non-word char) if
1495   ;; position is beyond fill-column.
1496   ;; Will not break **, //, or => (specified by f90-no-break-re).
1497   (f90-update-line)
1498   (while (> (current-column) fill-column)
1499       (let ((pos-mark (point-marker)))
1500         (move-to-column fill-column)
1501         (if (not (f90-in-string))
1502             (f90-find-breakpoint))
1503         (f90-break-line)
1504         (goto-char pos-mark)
1505         (set-marker pos-mark nil))))
1506
1507
1508 (defun f90-join-lines ()
1509   "Join present line with next line, if this line ends with \&."
1510   (interactive)
1511   (let (pos (oldpos (point)))
1512     (end-of-line)
1513     (skip-chars-backward " \t")
1514     (cond ((= (preceding-char) ?&)
1515            (delete-char -1)
1516            (setq pos (point))
1517            (forward-line 1)
1518            (skip-chars-forward " \t")
1519            (if (looking-at "\&") (delete-char 1))
1520            (delete-region pos (point))
1521            (if (not (f90-in-string))
1522                (progn (delete-horizontal-space) (insert " ")))
1523            (if (and auto-fill-function
1524                     (> (save-excursion (end-of-line)
1525                                        (current-column))
1526                        fill-column))
1527                (f90-do-auto-fill))
1528            (goto-char oldpos)
1529            t))))
1530
1531 (defun f90-fill-region (beg-region end-region)
1532   "Fill every line in region by forward parsing. Join lines if possible."
1533   (interactive "*r")
1534   (let ((end-region-mark (make-marker))
1535         (f90-smart-end nil) (f90-auto-keyword-case nil) (go-on t)
1536         (auto-fill-function nil))
1537     (set-marker end-region-mark end-region)
1538     (goto-char beg-region)
1539     (while go-on
1540       ;; join as much as possible
1541       (while (f90-join-lines))
1542       ;; chop the line if necessary
1543       (while (> (save-excursion (end-of-line) (current-column))
1544                 fill-column)
1545         (move-to-column fill-column)
1546         (f90-find-breakpoint)
1547         (f90-break-line 'no-update))
1548       (setq go-on (and  (< (point) (marker-position end-region-mark))
1549                         (zerop (forward-line 1))))
1550       (setq f90-cache-position (point)))
1551     (setq f90-cache-position nil)
1552     (if (string-match "XEmacs" emacs-version)
1553         (zmacs-deactivate-region)
1554       (deactivate-mark))))
1555 \f
1556 (defun f90-block-match (beg-block beg-name end-block end-name)
1557   "Match end-struct with beg-struct and complete end-block if possible.
1558 Leave point at the end of line."
1559   (search-forward "end" (f90-get-end-of-line))
1560   (catch 'no-match
1561     (if (not (f90-equal-symbols beg-block end-block))
1562         (if end-block
1563             (progn
1564               (message "END %s does not match %s." end-block beg-block)
1565               (end-of-line)
1566               (throw 'no-match nil))
1567           (message "Inserting %s." beg-block)
1568           (insert (concat " " beg-block)))
1569       (search-forward end-block))
1570     (if (not (f90-equal-symbols beg-name end-name))
1571         (cond ((and beg-name (not end-name))
1572                (message "Inserting %s." beg-name)
1573                (insert (concat " " beg-name)))
1574               ((and beg-name end-name)
1575                (message "Replacing %s with %s." end-name beg-name)
1576                (search-forward end-name)
1577                (replace-match beg-name))
1578               ((and (not beg-name) end-name)
1579                (message "Deleting %s." end-name)
1580                (search-forward end-name)
1581                (replace-match "")))
1582       (if end-name (search-forward end-name)))
1583     (if (not (looking-at "[ \t]*!")) (delete-horizontal-space))))
1584
1585 (defun f90-match-end ()
1586   "From an end foo statement, find the corresponding foo including name."
1587   (interactive)
1588   (let ((count 1) (top-of-window (window-start)) (matching-beg nil)
1589         (end-point (point)) (case-fold-search t)
1590         beg-name end-name beg-block end-block end-struct)
1591     (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")
1592                         (setq end-struct (f90-looking-at-program-block-end)))
1593         (progn
1594           (setq end-block (car end-struct))
1595           (setq end-name  (car (cdr end-struct)))
1596           (save-excursion
1597             (beginning-of-line)
1598             (while
1599                 (and (not (zerop count))
1600                      (let ((stop nil) notexist)
1601                        (while (not stop)
1602                          (setq notexist
1603                                (not (re-search-backward
1604                                      (concat "\\(" f90-blocks-re "\\)") nil t)))
1605                          (if notexist
1606                              (setq stop t)
1607                            (setq stop
1608                                  (not (or (f90-in-string)
1609                                           (f90-in-comment))))))
1610                        (not notexist)))
1611               (beginning-of-line) (skip-chars-forward " \t0-9")
1612               (cond ((setq matching-beg
1613                            (cond
1614                             ((f90-looking-at-do))
1615                             ((f90-looking-at-if-then))
1616                             ((f90-looking-at-where-or-forall))
1617                             ((f90-looking-at-select-case))
1618                             ((f90-looking-at-type-like))
1619                             ((f90-looking-at-program-block-start))))
1620                      (setq count (- count 1)))
1621                     ((looking-at (concat "end[ \t]*" f90-blocks-re "\\b"))
1622                      (setq count (+ count 1)))))
1623             (if (not (zerop count))
1624                 (message "No matching beginning.")
1625               (f90-update-line)
1626               (if (eq f90-smart-end 'blink)
1627                   (if (< (point) top-of-window)
1628                       (message "Matches %s: %s"
1629                                (what-line)
1630                                (buffer-substring
1631                                 (progn (beginning-of-line) (point))
1632                                 (progn (end-of-line) (point))))
1633                     (sit-for 1)))
1634               (setq beg-block (car matching-beg))
1635               (setq beg-name (car (cdr matching-beg)))
1636               (goto-char end-point)
1637               (beginning-of-line)
1638               (f90-block-match beg-block beg-name end-block end-name)))))))
1639
1640 (defun f90-insert-end ()
1641   "Inserts an complete end statement matching beginning of present block."
1642   (interactive)
1643   (let ((f90-smart-end (if f90-smart-end f90-smart-end 'blink)))
1644     (insert "end")
1645     (f90-indent-new-line)))
1646 \f
1647 ;; abbrevs and keywords
1648
1649 (defun f90-abbrev-start ()
1650   "Typing `\\[help-command] or `? lists all the F90 abbrevs.
1651 Any other key combination is executed normally."
1652   (interactive)
1653   (let (e c)
1654     (insert last-command-char)
1655     (if (string-match "XEmacs" emacs-version)
1656         (progn
1657           (setq e (next-command-event))
1658           (setq c (event-to-character e)))
1659       (setq c (read-event)))
1660     ;; insert char if not equal to `?'
1661     (if (or (= c ??) (eq c help-char))
1662         (f90-abbrev-help)
1663       (if (string-match "XEmacs" emacs-version)
1664           (setq unread-command-event e)
1665         (setq unread-command-events (list c))))))
1666
1667 (defun f90-abbrev-help ()
1668   "List the currently defined abbrevs in F90 mode."
1669   (interactive)
1670   (message "Listing abbrev table...")
1671   (display-buffer (f90-prepare-abbrev-list-buffer))
1672   (message "Listing abbrev table...done"))
1673
1674 (defun f90-prepare-abbrev-list-buffer ()
1675   (save-excursion
1676     (set-buffer (get-buffer-create "*Abbrevs*"))
1677     (erase-buffer)
1678     (insert-abbrev-table-description 'f90-mode-abbrev-table t)
1679     (goto-char (point-min))
1680     (set-buffer-modified-p nil)
1681     (edit-abbrevs-mode))
1682   (get-buffer-create "*Abbrevs*"))
1683
1684 (defun f90-upcase-keywords ()
1685   "Upcase all F90 keywords in the buffer."
1686   (interactive)
1687   (f90-change-keywords 'upcase-word))
1688
1689 (defun f90-capitalize-keywords ()
1690   "Capitalize all F90 keywords in the buffer."
1691   (interactive)
1692   (f90-change-keywords 'capitalize-word))
1693
1694 (defun f90-downcase-keywords ()
1695   "Downcase all F90 keywords in the buffer."
1696   (interactive)
1697   (f90-change-keywords 'downcase-word))
1698
1699 (defun f90-upcase-region-keywords (beg end)
1700   "Upcase all F90 keywords in the region."
1701   (interactive "*r")
1702   (f90-change-keywords 'upcase-word beg end))
1703
1704 (defun f90-capitalize-region-keywords (beg end)
1705   "Capitalize all F90 keywords in the region."
1706   (interactive "*r")
1707   (f90-change-keywords 'capitalize-word beg end))
1708
1709 (defun f90-downcase-region-keywords (beg end)
1710   "Downcase all F90 keywords in the region."
1711   (interactive "*r")
1712   (f90-change-keywords 'downcase-word beg end))
1713
1714 ;; Change the keywords according to argument.
1715 (defun f90-change-keywords (change-word &optional beg end)
1716   (save-excursion
1717     (setq beg (if beg beg (point-min)))
1718     (setq end (if end end (point-max)))
1719     (let ((keyword-re
1720            (concat "\\("
1721                    f90-keywords-re "\\|" f90-procedures-re "\\|"
1722                    f90-hpf-keywords-re "\\|" f90-operators-re "\\)"))
1723           (ref-point (point-min)) state
1724           (modified (buffer-modified-p)) saveword back-point)
1725       (goto-char beg)
1726       (unwind-protect
1727           (while (re-search-forward keyword-re end t)
1728             (if (progn
1729                   (setq state (parse-partial-sexp ref-point (point)))
1730                   (or (nth 3 state) (nth 4 state)
1731                       (save-excursion   ; Check for cpp directive.
1732                         (beginning-of-line)
1733                         (skip-chars-forward " \t0-9")
1734                         (looking-at "#"))))
1735                 ()
1736               (setq ref-point (point)
1737                     back-point (save-excursion (backward-word 1) (point)))
1738               (setq saveword (buffer-substring back-point ref-point))
1739               (funcall change-word -1)
1740               (or (string= saveword (buffer-substring back-point ref-point))
1741                   (setq modified t))))
1742         (or modified (set-buffer-modified-p nil))))))
1743
1744 (provide 'f90)
1745
1746 ;;; f90.el ends here