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

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