;;; f90.el --- Fortran-90 mode (free format)
;; Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007 Free Software Foundation, Inc.
+;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Torbj\"orn Einarsson <Torbjorn.Einarsson@era.ericsson.se>
;; Maintainer: Glenn Morris <rgm@gnu.org>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Major mode for editing F90 programs in FREE FORMAT.
;; The minor language revision F95 is also supported (with font-locking).
-;; Some aspects of F2003 are supported. At present, there are some
-;; problems with derived types.
+;; Some/many (?) aspects of F2003 are supported.
;; Knows about continuation lines, named structured statements, and other
;; features in F90 including HPF (High Performance Fortran) structures.
;; To facilitate typing, a fairly complete list of abbreviations is provided.
;; All abbreviations begin with the backquote character "`"
-;; (this requires modification of the syntax-table).
;; For example, `i expands to integer (if abbrev-mode is on).
;; There are two separate features for altering the appearance of code:
;;; Code:
;; TODO
-;; Have "f90-mode" just recognize F90 syntax, then derived modes
+;; 1. Any missing F2003 syntax?
+;; 2. Have "f90-mode" just recognize F90 syntax, then derived modes
;; "f95-mode", "f2003-mode" for the language revisions.
-;; Support for align.
-;; OpenMP, preprocessor highlighting.
-;; F2003 syntax:
-;; problems with derived types.
+;; 3. Support for align.
+;; Font-locking:
+;; 1. OpenMP, OpenMPI?, preprocessor highlighting.
+;; 2. integer_name = 1
+;; 3. Labels for "else" statements (F2003)?
(defvar comment-auto-fill-only-comments)
(defvar font-lock-keywords)
(defcustom f90-do-indent 3
"Extra indentation applied to DO blocks."
:type 'integer
+ :safe 'integerp
:group 'f90-indent)
(defcustom f90-if-indent 3
"Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks."
:type 'integer
+ :safe 'integerp
:group 'f90-indent)
(defcustom f90-type-indent 3
"Extra indentation applied to TYPE, ENUM, INTERFACE and BLOCK DATA blocks."
:type 'integer
+ :safe 'integerp
:group 'f90-indent)
(defcustom f90-program-indent 2
"Extra indentation applied to PROGRAM, MODULE, SUBROUTINE, FUNCTION blocks."
:type 'integer
+ :safe 'integerp
:group 'f90-indent)
(defcustom f90-associate-indent 2
"Extra indentation applied to ASSOCIATE blocks."
:type 'integer
+ :safe 'integerp
:group 'f90-indent
:version "23.1")
(defcustom f90-continuation-indent 5
"Extra indentation applied to continuation lines."
:type 'integer
+ :safe 'integerp
:group 'f90-indent)
(defcustom f90-comment-region "!!$"
"String inserted by \\[f90-comment-region] at start of each line in region."
:type 'string
+ :safe 'stringp
:group 'f90-indent)
(defcustom f90-indented-comment-re "!"
"Regexp matching comments to indent as code."
:type 'regexp
+ :safe 'stringp
:group 'f90-indent)
(defcustom f90-directive-comment-re "!hpf\\$"
"Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented."
:type 'regexp
+ :safe 'stringp
:group 'f90-indent)
(defcustom f90-beginning-ampersand t
"Non-nil gives automatic insertion of \& at start of continuation line."
:type 'boolean
+ :safe 'booleanp
:group 'f90)
(defcustom f90-smart-end 'blink
The other two settings have the same effect, but 'blink
additionally blinks the cursor to the start of the block."
:type '(choice (const blink) (const no-blink) (const nil))
+ :safe (lambda (value) (memq value '(blink no-blink nil)))
:group 'f90)
(defcustom f90-break-delimiters "[-+\\*/><=,% \t]"
"Regexp matching delimiter characters at which lines may be broken.
-There are certain tokens comprised entirely of characters
-matching this regexp that should not be split, and these are
-specified by the constant `f90-no-break-re'."
- :type 'regexp
+There are some common two-character tokens where one or more of
+the members matches this regexp. Although Fortran allows breaks
+within lexical tokens (provided the next line has a beginning ampersand),
+the constant `f90-no-break-re' ensures that such tokens are not split."
+ :type 'regexp
+ :safe 'stringp
:group 'f90)
(defcustom f90-break-before-delimiters t
"Non-nil causes `f90-do-auto-fill' to break lines before delimiters."
- :type 'boolean
+ :type 'boolean
+ :safe 'booleanp
:group 'f90)
(defcustom f90-auto-keyword-case nil
The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil."
:type '(choice (const downcase-word) (const upcase-word)
(const capitalize-word) (const nil))
+ :safe (lambda (value) (memq value '(downcase-word
+ capitalize-word upcase-word nil)))
:group 'f90)
(defcustom f90-leave-line-no nil
"If non-nil, line numbers are not left justified."
:type 'boolean
+ :safe 'booleanp
:group 'f90)
(defcustom f90-mode-hook nil
"Hook run when entering F90 mode."
:type 'hook
+ ;; Not the only safe options, but some common ones.
+ :safe (lambda (value) (member value '((f90-add-imenu-menu) nil)))
:options '(f90-add-imenu-menu)
:group 'f90)
;; F2003
"abstract" "associate" "asynchronous" "bind" "class"
"deferred" "enum" "enumerator" "extends" "extends_type_of"
- "final" "generic" "import" "non_overridable" "nopass" "pass"
- "protected" "same_type_as" "value" "volatile"
+ "final" "generic" "import" "non_intrinsic" "non_overridable"
+ "nopass" "pass" "protected" "same_type_as" "value" "volatile"
) 'words)
"Regexp used by the function `f90-change-keywords'.")
;; F95 keywords.
"elemental" "pure"
;; F2003. asynchronous separate.
- "abstract" "deferred" "import" "final" "non_overridable"
+ "abstract" "deferred" "import" "final" "non_intrinsic" "non_overridable"
"nopass" "pass" "protected" "value" "volatile"
) 'words)
"Keyword-regexp for font-lock level >= 3.")
"c_new_line" "c_carriage_return" "c_horizontal_tab"
"c_vertical_tab"
"c_ptr" "c_funptr" "c_null_ptr" "c_null_funptr"
+ "ieee_exceptions"
+ "ieee_arithmetic"
+ "ieee_features"
) 'words)
"Regexp for Fortran intrinsic constants.")
+;; cf f90-looking-at-type-like.
+(defun f90-typedef-matcher (limit)
+ "Search for the start/end of the definition of a derived type, up to LIMIT.
+Set the match data so that subexpression 1,2 are the TYPE, and
+type-name parts, respectively."
+ (let (found l)
+ (while (and (re-search-forward "\\<\\(\\(?:end[ \t]*\\)?type\\)\\>[ \t]*"
+ limit t)
+ (not (setq found
+ (progn
+ (setq l (match-data))
+ (unless (looking-at "\\(is\\>\\|(\\)")
+ (when (if (looking-at "\\(\\sw+\\)")
+ (goto-char (match-end 0))
+ (re-search-forward
+ "[ \t]*::[ \t]*\\(\\sw+\\)"
+ (line-end-position) t))
+ ;; 0 is wrong, but we don't use it.
+ (set-match-data
+ (append l (list (match-beginning 1)
+ (match-end 1))))
+ t)))))))
+ found))
+
(defvar f90-font-lock-keywords-1
(list
;; Special highlighting of "module procedure".
- '("\\<\\(module[ \t]*procedure\\)\\>" (1 font-lock-keyword-face))
+ '("\\<\\(module[ \t]*procedure\\)\\>\\([^()\n]*::\\)?[ \t]*\\([^&!\n]*\\)"
+ (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
;; Highlight definition of derived type.
- ;; FIXME F2003 use a function, same as looking-at-type-like?
- '("\\<\\(\\(?:end[ \t]*\\)?type\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
- (1 font-lock-keyword-face) (3 font-lock-function-name-face))
- ;; Other functions and declarations.
+;;; '("\\<\\(\\(?:end[ \t]*\\)?type\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
+;;; (1 font-lock-keyword-face) (3 font-lock-function-name-face))
+ '(f90-typedef-matcher
+ (1 font-lock-keyword-face) (2 font-lock-function-name-face))
+ ;; F2003. Prevent operators being highlighted as functions.
+ '("\\<\\(\\(?:end[ \t]*\\)?interface[ \t]*\\(?:assignment\\|operator\\|\
+read\\|write\\)\\)[ \t]*(" (1 font-lock-keyword-face t))
+ ;; Other functions and declarations. Named interfaces = F2003.
'("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|associate\\|\
-subroutine\\)\\|use\\|call\\)\\>[ \t]*\\(\\sw+\\)?"
+subroutine\\|interface\\)\\|use\\|call\\)\\>[ \t]*\\(\\sw+\\)?"
(1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
+ ;; F2003.
+ '("\\<\\(use\\)[ \t]*,[ \t]*\\(\\(?:non_\\)?intrinsic\\)[ \t]*::[ \t]*\
+\\(\\sw+\\)"
+ (1 font-lock-keyword-face) (2 font-lock-keyword-face)
+ (3 font-lock-function-name-face))
+ "\\<\\(\\(end[ \t]*\\)?block[ \t]*data\\|contains\\)\\>"
;; "abstract interface" is F2003.
- "\\<\\(\\(end[ \t]*\\)?\\(\\(?:abstract[ \t]+\\)?interface\\|\
-block[ \t]*data\\)\\|contains\\)\\>")
+ '("\\<abstract[ \t]*interface\\>" (0 font-lock-keyword-face t)))
"This does fairly subdued highlighting of comments and function calls.")
+;; NB not explicitly handling this, yet it seems to work.
+;; type(...) function foo()
+(defun f90-typedec-matcher (limit)
+ "Search for the declaration of variables of derived type, up to LIMIT.
+Set the match data so that subexpression 1,2 are the TYPE(...),
+and variable-name parts, respectively."
+ ;; Matcher functions must return nil only when there are no more
+ ;; matches within the search range.
+ (let (found l)
+ (while (and (re-search-forward "\\<\\(type\\|class\\)[ \t]*(" limit t)
+ (not
+ (setq found
+ (condition-case nil
+ (progn
+ ;; Set l after this to just highlight
+ ;; the "type" part.
+ (backward-char 1)
+ ;; Needed for: type( foo(...) ) :: bar
+ (forward-sexp)
+ (setq l (list (match-beginning 0) (point)))
+ (skip-chars-forward " \t")
+ (when
+ (re-search-forward
+ ;; type (foo) bar, qux
+ (if (looking-at "\\sw+")
+ "\\([^&!\n]+\\)"
+ ;; type (foo), stuff :: bar, qux
+ "::[ \t]*\\([^&!\n]+\\)")
+ (line-end-position) t)
+ (set-match-data
+ (append (list (car l) (match-end 1))
+ l (list (match-beginning 1)
+ (match-end 1))))
+ t))
+ (error nil))))))
+ found))
+
(defvar f90-font-lock-keywords-2
(append
f90-font-lock-keywords-1
(list
;; Variable declarations (avoid the real function call).
- ;; FIXME type( rational_t( this_k)), intent( in) :: a, b
- ;; maybe type should just work like integer.
- ;; Or use forward-sexp.
- '("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\
-enumerator\\|generic\\|procedure\\|\
-logical\\|double[ \t]*precision\\|\
-\\(?:type\\|class\\)[ \t]*([ \t]*\\sw+[ \t]*)\\)\
+ ;; NB by accident (?), this correctly fontifies the "integer" in:
+ ;; integer () function foo ()
+ ;; because "() function foo ()" matches \\3.
+ ;; The "pure" part does not really belong here, but was added to
+ ;; exploit that hack.
+ ;; The "function foo" bit is correctly fontified by keywords-1.
+ ;; TODO ? actually check for balanced parens in that case.
+ '("^[ \t0-9]*\\(?:pure\\|elemental\\)?[ \t]*\
+\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\
+enumerator\\|generic\\|procedure\\|logical\\|double[ \t]*precision\\)\
\\(.*::\\|[ \t]*(.*)\\)?\\([^&!\n]*\\)"
(1 font-lock-type-face t) (4 font-lock-variable-name-face t))
+ ;; Derived type/class variables.
+ ;; TODO ? If we just highlighted the "type" part, rather than
+ ;; "type(...)", this could be in the previous expression. And this
+ ;; would be consistent with integer( kind=8 ), etc.
+ '(f90-typedec-matcher
+ (1 font-lock-type-face) (2 font-lock-variable-name-face))
;; "real function foo (args)". Must override previous. Note hack
;; to get "args" unhighlighted again. Might not always be right,
;; but probably better than leaving them as variables.
- ;; FIXME in F2003, can specify kinds.
+ ;; NB not explicitly handling this case:
;; integer( kind=1 ) function foo()
+ ;; thanks to the happy accident described above.
+ ;; Not anchored, so don't need to worry about "pure" etc.
'("\\<\\(\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\
logical\\|double[ \t]*precision\\|\
\\(?:type\\|class\\)[ \t]*([ \t]*\\sw+[ \t]*)\\)[ \t]*\\)\
\\(function\\)\\>[ \t]*\\(\\sw+\\)[ \t]*\\(([^&!\n]*)\\)"
(1 font-lock-type-face t) (4 font-lock-keyword-face t)
(5 font-lock-function-name-face t) (6 'default t))
- ;; end do, if, enum (F2003), select, where, and forall constructs.
+ ;; enum (F2003; must be followed by ", bind(C)").
+ '("\\<\\(enum\\)[ \t]*," (1 font-lock-keyword-face))
+ ;; end do, enum (F2003), if, select, where, and forall constructs.
'("\\<\\(end[ \t]*\\(do\\|if\\|enum\\|select\\|forall\\|where\\)\\)\\>\
\\([ \t]+\\(\\sw+\\)\\)?"
(1 font-lock-keyword-face) (3 font-lock-constant-face nil t))
- '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|enum\\|\
+ '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\
do\\([ \t]*while\\)?\\|select[ \t]*\\(?:case\\|type\\)\\|where\\|\
forall\\)\\)\\>"
(2 font-lock-constant-face nil t) (3 font-lock-keyword-face))
(list
f90-keywords-level-3-re
f90-operators-re
+ ;; FIXME why isn't this font-lock-builtin-face, which
+ ;; otherwise we hardly use, as in fortran.el?
(list f90-procedures-re '(1 font-lock-keyword-face keep))
"\\<real\\>" ; avoid overwriting real defs
;; As an attribute, but not as an optional argument.
- '("\\<\\(asynchronous\\)[ \t]*[^=]" . 1)
- ))
+ '("\\<\\(asynchronous\\)[ \t]*[^=]" . 1)))
"Highlights all F90 keywords and intrinsic procedures.")
(defvar f90-font-lock-keywords-4
(let ((table (make-syntax-table)))
(modify-syntax-entry ?\! "<" table) ; begin comment
(modify-syntax-entry ?\n ">" table) ; end comment
+ ;; FIXME: This goes against the convention: it should be "_".
(modify-syntax-entry ?_ "w" table) ; underscore in names
(modify-syntax-entry ?\' "\"" table) ; string quote
(modify-syntax-entry ?\" "\"" table) ; string quote
- (modify-syntax-entry ?\` "w" table) ; for abbrevs
+ ;; FIXME: We used to set ` to word syntax for the benefit of abbrevs, but
+ ;; we do not need it any more. Not sure if it should be "_" or "." now.
+ (modify-syntax-entry ?\` "_" table)
(modify-syntax-entry ?\r " " table) ; return is whitespace
(modify-syntax-entry ?+ "." table) ; punctuation
(modify-syntax-entry ?- "." table)
(modify-syntax-entry ?= "." table)
(modify-syntax-entry ?* "." table)
(modify-syntax-entry ?/ "." table)
- ;; I think that the f95 standard leaves the behaviour of \
+ ;; I think that the f95 standard leaves the behavior of \
;; unspecified, but that f2k will require it to be non-special.
;; Use `f90-backslash-not-special' to change.
(modify-syntax-entry ?\\ "\\" table) ; escape chars
(define-key map "\C-\M-p" 'f90-beginning-of-block)
(define-key map "\C-\M-q" 'f90-indent-subprogram)
(define-key map "\C-j" 'f90-indent-new-line) ; LFD equals C-j
- (define-key map "\r" 'newline)
+;;; (define-key map "\r" 'newline)
(define-key map "\C-c\r" 'f90-break-line)
;;; (define-key map [M-return] 'f90-break-line)
(define-key map "\C-c\C-a" 'f90-previous-block)
(define-key map "\C-c\C-p" 'f90-previous-statement)
(define-key map "\C-c\C-n" 'f90-next-statement)
(define-key map "\C-c\C-w" 'f90-insert-end)
- (define-key map "\t" 'f90-indent-line)
+ ;; Standard tab binding will call this, and also handle regions.
+;;; (define-key map "\t" 'f90-indent-line)
(define-key map "," 'f90-electric-insert)
(define-key map "+" 'f90-electric-insert)
(define-key map "-" 'f90-electric-insert)
`("F90"
("Customization"
,(custom-menu-create 'f90)
- ["Set" Custom-set t]
- ["Save" Custom-save t]
- ["Reset to Current" Custom-reset-current t]
- ["Reset to Saved" Custom-reset-saved t]
- ["Reset to Standard Settings" Custom-reset-standard t]
+ ;; FIXME useless?
+ ["Set" Custom-set :active t
+ :help "Set current value of all edited settings in the buffer"]
+ ["Save" Custom-save :active t
+ :help "Set and save all edited settings"]
+ ["Reset to Current" Custom-reset-current :active t
+ :help "Reset all edited settings to current"]
+ ["Reset to Saved" Custom-reset-saved :active t
+ :help "Reset all edited or set settings to saved"]
+ ["Reset to Standard Settings" Custom-reset-standard :active t
+ :help "Erase all cusomizations in buffer"]
)
"--"
- ["Indent Subprogram" f90-indent-subprogram t]
- ["Mark Subprogram" f90-mark-subprogram t]
- ["Beginning of Subprogram" f90-beginning-of-subprogram t]
- ["End of Subprogram" f90-end-of-subprogram t]
+ ["Indent Subprogram" f90-indent-subprogram t]
+ ["Mark Subprogram" f90-mark-subprogram :active t :help
+ "Mark the end of the current subprogram, move point to the start"]
+ ["Beginning of Subprogram" f90-beginning-of-subprogram :active t
+ :help "Move point to the start of the current subprogram"]
+ ["End of Subprogram" f90-end-of-subprogram :active t
+ :help "Move point to the end of the current subprogram"]
"--"
- ["(Un)Comment Region" f90-comment-region mark-active]
- ["Indent Region" f90-indent-region mark-active]
- ["Fill Region" f90-fill-region mark-active]
+ ["(Un)Comment Region" f90-comment-region :active mark-active
+ :help "Comment or uncomment the region"]
+ ["Indent Region" f90-indent-region :active mark-active]
+ ["Fill Region" f90-fill-region :active mark-active
+ :help "Fill long lines in the region"]
"--"
- ["Break Line at Point" f90-break-line t]
- ["Join with Previous Line" f90-join-lines t]
- ["Insert Block End" f90-insert-end t]
+ ["Break Line at Point" f90-break-line :active t
+ :help "Break the current line at point"]
+ ["Join with Previous Line" f90-join-lines :active t
+ :help "Join the current line to the previous one"]
+ ["Insert Block End" f90-insert-end :active t
+ :help "Insert an end statement for the current code block"]
"--"
("Highlighting"
+ :help "Fontify this buffer to varying degrees"
["Toggle font-lock-mode" font-lock-mode :selected font-lock-mode
- :style toggle]
+ :style toggle :help "Fontify text in this buffer"]
"--"
["Light highlighting (level 1)" f90-font-lock-1 t]
["Moderate highlighting (level 2)" f90-font-lock-2 t]
["Maximum highlighting (level 4)" f90-font-lock-4 t]
)
("Change Keyword Case"
+ :help "Change the case of keywords in the buffer or region"
["Upcase Keywords (buffer)" f90-upcase-keywords t]
["Capitalize Keywords (buffer)" f90-capitalize-keywords t]
["Downcase Keywords (buffer)" f90-downcase-keywords t]
mark-active]
)
"--"
- ["Toggle auto-fill" auto-fill-mode :selected auto-fill-function
- :style toggle]
- ["Toggle abbrev-mode" abbrev-mode :selected abbrev-mode
- :style toggle]
- ["Add imenu Menu" f90-add-imenu-menu
+ ["Toggle Auto Fill" auto-fill-mode :selected auto-fill-function
+ :style toggle
+ :help "Automatically fill text while typing in this buffer"]
+ ["Toggle Abbrev Mode" abbrev-mode :selected abbrev-mode
+ :style toggle :help "Expand abbreviations while typing in this buffer"]
+ ["Add Imenu Menu" f90-add-imenu-menu
:active (not (lookup-key (current-local-map) [menu-bar index]))
- :included (fboundp 'imenu-add-to-menubar)]))
+ :included (fboundp 'imenu-add-to-menubar)
+ :help "Add an index menu to the menu-bar"
+ ]))
map)
"Keymap used in F90 mode.")
+(defun f90-font-lock-n (n)
+ "Set `font-lock-keywords' to F90 level N keywords."
+ (font-lock-mode 1)
+ (setq font-lock-keywords
+ (symbol-value (intern-soft (format "f90-font-lock-keywords-%d" n))))
+ (font-lock-fontify-buffer))
+
(defun f90-font-lock-1 ()
"Set `font-lock-keywords' to `f90-font-lock-keywords-1'."
(interactive)
- (font-lock-mode 1)
- (setq font-lock-keywords f90-font-lock-keywords-1)
- (font-lock-fontify-buffer))
+ (f90-font-lock-n 1))
(defun f90-font-lock-2 ()
"Set `font-lock-keywords' to `f90-font-lock-keywords-2'."
(interactive)
- (font-lock-mode 1)
- (setq font-lock-keywords f90-font-lock-keywords-2)
- (font-lock-fontify-buffer))
+ (f90-font-lock-n 2))
(defun f90-font-lock-3 ()
"Set `font-lock-keywords' to `f90-font-lock-keywords-3'."
(interactive)
- (font-lock-mode 1)
- (setq font-lock-keywords f90-font-lock-keywords-3)
- (font-lock-fontify-buffer))
+ (f90-font-lock-n 3))
(defun f90-font-lock-4 ()
"Set `font-lock-keywords' to `f90-font-lock-keywords-4'."
(interactive)
- (font-lock-mode 1)
- (setq font-lock-keywords f90-font-lock-keywords-4)
- (font-lock-fontify-buffer))
-
+ (f90-font-lock-n 4))
\f
;; Regexps for finding program structures.
(defconst f90-blocks-re
"Regexp matching a CLASS/TYPE IS statement.")
(defconst f90-no-break-re
- (regexp-opt '("**" "//" "=>" ">=" "<=" "==" "/=") 'paren)
- "Regexp specifying where not to break lines when filling.
-This regexp matches certain tokens comprised entirely of
-characters matching the regexp `f90-break-delimiters' that should
-not be split by filling. Each element is assumed to be two
-characters long.")
+ (regexp-opt '("**" "//" "=>" ">=" "<=" "==" "/=" "(/" "/)") 'paren)
+ "Regexp specifying two-character tokens not to split when breaking lines.
+Each token has one or more of the characters from `f90-break-delimiters'.
+Note that if only one of the characters is from that variable,
+then the presence of the token here allows a line-break before or
+after the other character, where a break would not normally be
+allowed. This minor issue currently only affects \"(/\" and \"/)\".")
(defvar f90-cache-position nil
"Temporary position used to speed up region operations.")
;; Avoid F2003 "type is" in "select type",
;; and also variables of derived type "type (foo)".
;; "type, foo" must be a block (?).
- "type[ \t,]\\([^(is]\\|[^(i].\\|[^(][^s]\\|is\\sw\\)"
- "\\|"
+ "type[ \t,]\\("
+ "[^i(!\n\"\& \t]\\|" ; not-i(
+ "i[^s!\n\"\& \t]\\|" ; i not-s
+ "is\\sw\\)\\|"
;; "abstract interface" is F2003.
- "program\\|\\(?:abstract[ \t]+\\)?interface\\|module\\|"
+ "program\\|\\(?:abstract[ \t]*\\)?interface\\|module\\|"
;; "enum", but not "enumerator".
"function\\|subroutine\\|enum[^e]\\|associate"
"\\)"
\f
;; Imenu support.
-;; FIXME F2003
+;; FIXME trivial to extend this to enum. Worth it?
+(defun f90-imenu-type-matcher ()
+ "Search backward for the start of a derived type.
+Set subexpression 1 in the match-data to the name of the type."
+ (let (found)
+ (while (and (re-search-backward "^[ \t0-9]*type[ \t]*" nil t)
+ (not (setq found
+ (save-excursion
+ (goto-char (match-end 0))
+ (unless (looking-at "\\(is\\>\\|(\\)")
+ (or (looking-at "\\(\\sw+\\)")
+ (re-search-forward
+ "[ \t]*::[ \t]*\\(\\sw+\\)"
+ (line-end-position) t))))))))
+ found))
+
(defvar f90-imenu-generic-expression
(let ((good-char "[^!\"\&\n \t]") (not-e "[^e!\n\"\& \t]")
- (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]"))
+ (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]")
+ ;; (not-ib "[^i(!\n\"\& \t]") (not-s "[^s!\n\"\& \t]")
+ )
(list
'(nil "^[ \t0-9]*program[ \t]+\\(\\sw+\\)" 1)
'("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1)
- '("Types" "^[ \t0-9]*type[ \t]+\\(\\sw+\\)" 1)
+ (list "Types" 'f90-imenu-type-matcher 1)
+ ;; Does not handle: "type[, stuff] :: foo".
+;;; (format "^[ \t0-9]*type[ \t]+\\(\\(%s\\|i%s\\|is\\sw\\)\\sw*\\)"
+;;; not-ib not-s)
+;;; 1)
+ ;; Can't get the subexpression numbers to match in the two branches.
+;;; (format "^[ \t0-9]*type\\([ \t]*,.*\\(::\\)[ \t]*\\(\\sw+\\)\\|[ \t]+\\(\\(%s\\|i%s\\|is\\sw\\)\\sw*\\)\\)" not-ib not-s)
+;;; 3)
(list
"Procedures"
(concat
\f
;; Abbrevs have generally two letters, except standard types `c, `i, `r, `t.
-(defvar f90-mode-abbrev-table
- (progn
- (define-abbrev-table 'f90-mode-abbrev-table nil)
- f90-mode-abbrev-table)
- "Abbrev table for F90 mode.")
-
-(let (abbrevs-changed)
- ;; Use the 6th arg (SYSTEM-FLAG) of define-abbrev if possible.
- ;; A little baroque to quieten the byte-compiler.
- (mapc
- (function (lambda (element)
- (condition-case nil
- (apply 'define-abbrev f90-mode-abbrev-table
- (append element '(nil 0 t)))
- (wrong-number-of-arguments
- (apply 'define-abbrev f90-mode-abbrev-table
- (append element '(nil 0)))))))
- '(("`al" "allocate" )
- ("`ab" "allocatable" )
- ("`as" "assignment" )
-; ("`at" "abstract" )
-; ("`ay" "asynchronous" )
- ("`ba" "backspace" )
- ("`bd" "block data" )
- ("`c" "character" )
- ("`cl" "close" )
- ("`cm" "common" )
- ("`cx" "complex" )
- ("`cn" "contains" )
- ("`cy" "cycle" )
- ("`de" "deallocate" )
- ("`df" "define" )
- ("`di" "dimension" )
- ("`dp" "double precision")
- ("`dw" "do while" )
- ("`el" "else" )
- ("`eli" "else if" )
- ("`elw" "elsewhere" )
-; ("`em" "elemental" )
- ("`en" "enumerator" )
- ("`eq" "equivalence" )
- ("`ex" "external" )
- ("`ey" "entry" )
- ("`fl" "forall" )
- ("`fo" "format" )
- ("`fu" "function" )
- ("`fa" ".false." )
- ("`im" "implicit none")
- ("`in" "include" )
- ("`i" "integer" )
- ("`it" "intent" )
- ("`if" "interface" )
- ("`lo" "logical" )
- ("`mo" "module" )
- ("`na" "namelist" )
- ("`nu" "nullify" )
- ("`op" "optional" )
- ("`pa" "parameter" )
- ("`po" "pointer" )
- ("`pr" "print" )
- ("`pi" "private" )
- ("`pm" "program" )
- ("`pr" "protected" )
- ("`pu" "public" )
- ("`r" "real" )
- ("`rc" "recursive" )
- ("`rt" "return" )
- ("`rw" "rewind" )
- ("`se" "select" )
- ("`sq" "sequence" )
- ("`su" "subroutine" )
- ("`ta" "target" )
- ("`tr" ".true." )
- ("`t" "type" )
- ("`vo" "volatile" )
- ("`wh" "where" )
- ("`wr" "write" ))))
-
+(define-abbrev-table 'f90-mode-abbrev-table
+ (mapcar (lambda (e) (list (car e) (cdr e) nil :system t))
+ '(("`al" . "allocate" )
+ ("`ab" . "allocatable" )
+ ("`ai" . "abstract interface")
+ ("`as" . "assignment" )
+ ("`asy" . "asynchronous" )
+ ("`ba" . "backspace" )
+ ("`bd" . "block data" )
+ ("`c" . "character" )
+ ("`cl" . "close" )
+ ("`cm" . "common" )
+ ("`cx" . "complex" )
+ ("`cn" . "contains" )
+ ("`cy" . "cycle" )
+ ("`de" . "deallocate" )
+ ("`df" . "define" )
+ ("`di" . "dimension" )
+ ("`dp" . "double precision")
+ ("`dw" . "do while" )
+ ("`el" . "else" )
+ ("`eli" . "else if" )
+ ("`elw" . "elsewhere" )
+ ("`em" . "elemental" )
+ ("`e" . "enumerator" )
+ ("`eq" . "equivalence" )
+ ("`ex" . "external" )
+ ("`ey" . "entry" )
+ ("`fl" . "forall" )
+ ("`fo" . "format" )
+ ("`fu" . "function" )
+ ("`fa" . ".false." )
+ ("`im" . "implicit none")
+ ("`in" . "include" )
+ ("`i" . "integer" )
+ ("`it" . "intent" )
+ ("`if" . "interface" )
+ ("`lo" . "logical" )
+ ("`mo" . "module" )
+ ("`na" . "namelist" )
+ ("`nu" . "nullify" )
+ ("`op" . "optional" )
+ ("`pa" . "parameter" )
+ ("`po" . "pointer" )
+ ("`pr" . "print" )
+ ("`pi" . "private" )
+ ("`pm" . "program" )
+ ("`pr" . "protected" )
+ ("`pu" . "public" )
+ ("`r" . "real" )
+ ("`rc" . "recursive" )
+ ("`rt" . "return" )
+ ("`rw" . "rewind" )
+ ("`se" . "select" )
+ ("`sq" . "sequence" )
+ ("`su" . "subroutine" )
+ ("`ta" . "target" )
+ ("`tr" . ".true." )
+ ("`t" . "type" )
+ ("`vo" . "volatile" )
+ ("`wh" . "where" )
+ ("`wr" . "write" )))
+ "Abbrev table for F90 mode."
+ ;; Accept ` as the first char of an abbrev. Also allow _ in abbrevs.
+ :regexp "\\(?:[^[:word:]_`]\\|^\\)\\(`?[[:word:]_]+\\)[^[:word:]_]*")
\f
;;;###autoload
(defun f90-mode ()
(defsubst f90-looking-at-type-like ()
"Return (KIND NAME) if a type/enum/interface/block-data starts after point.
-NAME is non-nil only for type."
+NAME is non-nil only for type and certain interfaces."
(cond
((save-excursion
- (and (looking-at "\\<type[ \t]*")
+ (and (looking-at "\\<type\\>[ \t]*")
(goto-char (match-end 0))
(not (looking-at "\\(is\\>\\|(\\)"))
(or (looking-at "\\(\\sw+\\)")
;;; ((and (not (looking-at f90-typeis-re))
;;; (looking-at f90-type-def-re))
;;; (list (match-string 1) (match-string 2)))
- ((looking-at "\\(enum\\|interface\\|block[ \t]*data\\)\\>")
+ ((looking-at "\\<\\(interface\\)\\>[ \t]*")
+ (list (match-string 1)
+ (save-excursion
+ (goto-char (match-end 0))
+ (if (or (looking-at "\\(operator\\|assignment\\|read\\|\
+write\\)[ \t]*([^)\n]*)")
+ (looking-at "\\sw+"))
+ (match-string 0)))))
+ ((looking-at "\\(enum\\|block[ \t]*data\\)\\>")
(list (match-string 1) nil))
((looking-at "abstract[ \t]*\\(interface\\)\\>")
(list (match-string 1) nil))))
(defsubst f90-looking-at-program-block-end ()
"Return (KIND NAME) if a block with name NAME ends after point."
- (if (looking-at (concat "end[ \t]*" f90-blocks-re
- "?\\([ \t]+\\(\\sw+\\)\\)?\\>"))
- (list (match-string 1) (match-string 3))))
+ (cond ((looking-at "end[ \t]*\\(interface\\)[ \t]*\\(\
+\\(?:assignment\\|operator\\|read\\|write\\)[ \t]*([^)\n]*)\\)")
+ (list (match-string 1) (match-string 2)))
+ ((looking-at (concat "end[ \t]*" f90-blocks-re
+ "?\\([ \t]+\\(\\sw+\\)\\)?\\>"))
+ (list (match-string 1) (match-string 3)))))
(defsubst f90-comment-indent ()
"Return the indentation to be used for a comment starting at point.
(looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\
\\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\)\\>")
(looking-at "\\(program\\|module\\|\
-\\(?:abstract[ \t]+\\)?interface\\|block[ \t]*data\\)\\>")
+\\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\>")
(looking-at "\\(contains\\|\\sw+[ \t]*:\\)")
(looking-at f90-type-def-re)
(re-search-forward "\\(function\\|subroutine\\)"
(if auto-fill-function (f90-do-auto-fill) ; also updates line
(f90-update-line)))
+;; Behave like self-insert-command for delete-selection-mode (bug#5593).
+(put 'f90-electric-insert 'delete-selection t)
(defun f90-get-correct-indent ()
"Get correct indent for a line starting with line number.
(let ((epnt (line-end-position)) icol cont)
(save-excursion
(while (and (f90-previous-statement)
- (or (progn
- (setq cont (f90-present-statement-cont))
- (or (eq cont 'end) (eq cont 'middle)))
+ (or (memq (setq cont (f90-present-statement-cont))
+ '(middle end))
(looking-at "[ \t]*[0-9]"))))
(setq icol (current-indentation))
(beginning-of-line)
(setq icol (- icol f90-associate-indent)))
((or (looking-at "contains[ \t]*\\(!\\|$\\)")
(f90-looking-at-program-block-end))
- (setq icol (- icol f90-program-indent))))))
- ))))
+ (setq icol (- icol f90-program-indent))))))))))
icol))
\f
(defun f90-previous-statement ()
matching-beg
;; Note this includes the case of an un-named main program,
;; in which case we go to (point-min).
- (message "No beginning found.")
+ (if (called-interactively-p 'interactive)
+ (message "No beginning found"))
nil)))
(defun f90-end-of-subprogram ()
Return (TYPE NAME), or nil if not found."
(interactive)
(let ((case-fold-search t)
- (count 1)
+ (count 1)
matching-end)
(end-of-line)
(while (and (> count 0)
;;; (forward-line 1)
(if (zerop count)
matching-end
- (message "No end found.")
+ (if (called-interactively-p 'interactive)
+ (message "No end found"))
nil)))
completes outermost block if `f90-smart-end' is non-nil.
Interactively, pushes mark before moving point."
(interactive "p")
- (if (interactive-p) (push-mark (point) t)) ; can move some distance
+ ;; Can move some distance.
+ (if (called-interactively-p 'any) (push-mark (point) t))
(and num (< num 0) (f90-beginning-of-block (- num)))
(let ((f90-smart-end (if f90-smart-end 'no-blink)) ; for final match-end
(case-fold-search t)
Does not check the outermost block, because it may be incomplete.
Interactively, pushes mark before moving point."
(interactive "p")
- (if (interactive-p) (push-mark (point) t))
+ (if (called-interactively-p 'any) (push-mark (point) t))
(and num (< num 0) (f90-end-of-block (- num)))
(let ((case-fold-search t)
(count (or num 1))
(push-mark)
(goto-char pos)
(setq program (f90-beginning-of-subprogram))
- (if (fboundp 'zmacs-activate-region)
+ (if (featurep 'xemacs)
(zmacs-activate-region)
(setq mark-active t
deactivate-mark nil))
(zerop (forward-line 1)))
(< (point) end-region-mark)))
(setq cont (f90-present-statement-cont))
- (while (and (or (eq cont 'middle) (eq cont 'end))
+ (while (and (memq cont '(middle end))
(f90-previous-statement))
(setq cont (f90-present-statement-cont)))
;; Process present line for beginning of block.
block-list (cdr block-list))
(if f90-smart-end
(save-excursion
- (f90-block-match (car beg-struct) (car (cdr beg-struct))
- (car end-struct) (car (cdr end-struct)))))
+ (f90-block-match (car beg-struct) (cadr beg-struct)
+ (car end-struct) (cadr end-struct))))
(setq ind-b
(cond ((looking-at f90-end-if-re) f90-if-indent)
((looking-at "end[ \t]*do\\>") f90-do-indent)
(goto-char save-point)
(set-marker end-region-mark nil)
(set-marker save-point nil)
- (if (fboundp 'zmacs-deactivate-region)
+ (if (featurep 'xemacs)
(zmacs-deactivate-region)
(deactivate-mark))))
(if program
(progn
(message "Indenting %s %s..."
- (car program) (car (cdr program)))
+ (car program) (cadr program))
(indent-region (point) (mark) nil)
(message "Indenting %s %s...done"
- (car program) (car (cdr program))))
+ (car program) (cadr program)))
(message "Indenting the whole file...")
(indent-region (point) (mark) nil)
(message "Indenting the whole file...done")))))
(t (insert "&")
(or no-update (f90-update-line))
(newline 1)
+ ;; FIXME also need leading ampersand if split lexical token (eg ==).
+ ;; Or respect f90-no-break-re.
(if f90-beginning-ampersand (insert "&"))))
(indent-according-to-mode))
f90-cache-position (point)))
(setq f90-cache-position nil)
(set-marker end-region-mark nil)
- (if (fboundp 'zmacs-deactivate-region)
+ (if (featurep 'xemacs)
(zmacs-deactivate-region)
(deactivate-mark))))
\f
(when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")
(setq end-struct (f90-looking-at-program-block-end)))
(setq end-block (car end-struct)
- end-name (car (cdr end-struct)))
+ end-name (cadr end-struct))
(save-excursion
(beginning-of-line)
(while (and (> count 0)
(line-end-position)))
(sit-for blink-matching-delay)))
(setq beg-block (car matching-beg)
- beg-name (car (cdr matching-beg)))
+ beg-name (cadr matching-beg))
(goto-char end-point)
(beginning-of-line)
(f90-block-match beg-block beg-name end-block end-name))))))
"Typing `\\[help-command] or `? lists all the F90 abbrevs.
Any other key combination is executed normally."
(interactive "*")
- (insert last-command-char)
+ (insert last-command-event)
(let (char event)
(if (fboundp 'next-command-event) ; XEmacs
(setq event (next-command-event)
(setq event (read-event)
char event))
;; Insert char if not equal to `?', or if abbrev-mode is off.
- (if (and abbrev-mode (or (eq char ??) (eq char help-char)))
+ (if (and abbrev-mode (memq char (list ?? help-char)))
(f90-abbrev-help)
(setq unread-command-events (list event)))))
(defun f90-prepare-abbrev-list-buffer ()
"Create a buffer listing the F90 mode abbreviations."
- (save-excursion
- (set-buffer (get-buffer-create "*Abbrevs*"))
+ (with-current-buffer (get-buffer-create "*Abbrevs*")
(erase-buffer)
(insert-abbrev-table-description 'f90-mode-abbrev-table t)
(goto-char (point-min))
(funcall change-word -1)
(or (string= saveword (buffer-substring back-point ref-point))
(setq modified t))))
- (or modified (set-buffer-modified-p nil))))))
+ (or modified (restore-buffer-modified-p nil))))))
(defun f90-current-defun ()
(provide 'f90)
-;;; arch-tag: fceac97c-c147-44bd-aec0-172d4b560ef8
+;; arch-tag: fceac97c-c147-44bd-aec0-172d4b560ef8
;;; f90.el ends here