lisp/progmodes/f90.el

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