;;; 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 Free Software Foundation, Inc.
;; Author: Torbj\"orn Einarsson <Torbjorn.Einarsson@era.ericsson.se>
;; Maintainer: Glenn Morris <rgm@gnu.org>
;; Major mode for editing F90 programs in FREE FORMAT.
;; The minor language revision F95 is also supported (with font-locking).
+;; 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.
;;; Code:
;; TODO
-;; Support for align.
-;; OpenMP, preprocessor highlighting.
+;; 1. Any missing F2003 syntax?
+;; 2. Have "f90-mode" just recognize F90 syntax, then derived modes
+;; "f95-mode", "f2003-mode" for the language revisions.
+;; 3. Support for align.
+;; Font-locking:
+;; 1. OpenMP, OpenMPI?, preprocessor highlighting.
+;; 2. interface blah - Highlight "blah" in function-name face?
+;; Need to avoid "interface operator (+)" etc.
+;; 3. integer_name = 1
+;; 4. Labels for "else" statements (F2003)?
(defvar comment-auto-fill-only-comments)
(defvar font-lock-keywords)
"Extra indentation applied to DO blocks."
:type 'integer
:group 'f90-indent)
+(put 'f90-do-indent 'safe-local-variable 'integerp)
(defcustom f90-if-indent 3
"Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks."
:type 'integer
:group 'f90-indent)
+(put 'f90-if-indent 'safe-local-variable 'integerp)
(defcustom f90-type-indent 3
- "Extra indentation applied to TYPE, INTERFACE and BLOCK DATA blocks."
+ "Extra indentation applied to TYPE, ENUM, INTERFACE and BLOCK DATA blocks."
:type 'integer
:group 'f90-indent)
+(put 'f90-type-indent 'safe-local-variable 'integerp)
(defcustom f90-program-indent 2
"Extra indentation applied to PROGRAM, MODULE, SUBROUTINE, FUNCTION blocks."
:type 'integer
:group 'f90-indent)
+(put 'f90-program-indent 'safe-local-variable 'integerp)
+
+(defcustom f90-associate-indent 2
+ "Extra indentation applied to ASSOCIATE blocks."
+ :type 'integer
+ :group 'f90-indent
+ :version "23.1")
+(put 'f90-associate-indent 'safe-local-variable 'integerp)
(defcustom f90-continuation-indent 5
"Extra indentation applied to continuation lines."
:type 'integer
:group 'f90-indent)
+(put 'f90-continuation-indent 'safe-local-variable 'integerp)
(defcustom f90-comment-region "!!$"
"String inserted by \\[f90-comment-region] at start of each line in region."
:type 'string
:group 'f90-indent)
+(put 'f90-comment-region 'safe-local-variable 'stringp)
(defcustom f90-indented-comment-re "!"
"Regexp matching comments to indent as code."
:type 'regexp
:group 'f90-indent)
+(put 'f90-indented-comment-re 'safe-local-variable 'stringp)
(defcustom f90-directive-comment-re "!hpf\\$"
"Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented."
:type 'regexp
:group 'f90-indent)
+(put 'f90-directive-comment-re 'safe-local-variable 'stringp)
(defcustom f90-beginning-ampersand t
"Non-nil gives automatic insertion of \& at start of continuation line."
:type 'boolean
:group 'f90)
+(put 'f90-beginning-ampersand 'safe-local-variable 'booleanp)
(defcustom f90-smart-end 'blink
"Qualification of END statements according to the matching block start.
additionally blinks the cursor to the start of the block."
:type '(choice (const blink) (const no-blink) (const nil))
:group 'f90)
+(put 'f90-smart-end 'safe-local-variable
+ (lambda (value) (memq value '(blink no-blink nil))))
(defcustom f90-break-delimiters "[-+\\*/><=,% \t]"
"Regexp matching delimiter characters at which lines may be broken.
specified by the constant `f90-no-break-re'."
:type 'regexp
:group 'f90)
+(put 'f90-break-delimiters 'safe-local-variable 'stringp)
(defcustom f90-break-before-delimiters t
"Non-nil causes `f90-do-auto-fill' to break lines before delimiters."
:type 'boolean
:group 'f90)
+(put 'f90-break-before-delimiters 'safe-local-variable 'booleanp)
(defcustom f90-auto-keyword-case nil
"Automatic case conversion of keywords.
:type '(choice (const downcase-word) (const upcase-word)
(const capitalize-word) (const nil))
:group 'f90)
+(put 'f90-auto-keyword-case 'safe-local-variable
+ (lambda (value) (memq value '(downcase-word
+ capitalize-word upcase-word nil))))
(defcustom f90-leave-line-no nil
"If non-nil, line numbers are not left justified."
:type 'boolean
:group 'f90)
+(put 'f90-leave-line-no 'safe-local-variable 'booleanp)
(defcustom f90-mode-hook nil
"Hook run when entering F90 mode."
:type 'hook
:options '(f90-add-imenu-menu)
:group 'f90)
+(put 'f90-mode-hook 'safe-local-variable
+ (lambda (value) (member value '((f90-add-imenu-menu) nil))))
;; User options end here.
"rewind" "save" "select" "sequence" "stop" "subroutine"
"target" "then" "type" "use" "where" "while" "write"
;; F95 keywords.
- "elemental" "pure") 'words)
+ "elemental" "pure"
+ ;; F2003
+ "abstract" "associate" "asynchronous" "bind" "class"
+ "deferred" "enum" "enumerator" "extends" "extends_type_of"
+ "final" "generic" "import" "non_intrinsic" "non_overridable"
+ "nopass" "pass" "protected" "same_type_as" "value" "volatile"
+ ) 'words)
"Regexp used by the function `f90-change-keywords'.")
(defconst f90-keywords-level-3-re
'("allocatable" "allocate" "assign" "assignment" "backspace"
"close" "deallocate" "dimension" "endfile" "entry" "equivalence"
"external" "inquire" "intent" "intrinsic" "nullify" "only" "open"
+ ;; FIXME operator and assignment should be F2003 procedures?
"operator" "optional" "parameter" "pause" "pointer" "print" "private"
"public" "read" "recursive" "result" "rewind" "save" "select"
"sequence" "target" "write"
;; F95 keywords.
- "elemental" "pure") 'words)
+ "elemental" "pure"
+ ;; F2003. asynchronous separate.
+ "abstract" "deferred" "import" "final" "non_intrinsic" "non_overridable"
+ "nopass" "pass" "protected" "value" "volatile"
+ ) 'words)
"Keyword-regexp for font-lock level >= 3.")
(defconst f90-procedures-re
"sum" "system_clock" "tan" "tanh" "tiny" "transfer"
"transpose" "trim" "ubound" "unpack" "verify"
;; F95 intrinsic functions.
- "null" "cpu_time") t)
+ "null" "cpu_time"
+ ;; F2003.
+ "move_alloc" "command_argument_count" "get_command"
+ "get_command_argument" "get_environment_variable"
+ "selected_char_kind" "wait" "flush" "new_line"
+ "extends" "extends_type_of" "same_type_as" "bind"
+ ;; F2003 ieee_arithmetic intrinsic module.
+ "ieee_support_underflow_control" "ieee_get_underflow_mode"
+ "ieee_set_underflow_mode"
+ ;; F2003 iso_c_binding intrinsic module.
+ "c_loc" "c_funloc" "c_associated" "c_f_pointer"
+ "c_f_procpointer"
+ ) t)
;; A left parenthesis to avoid highlighting non-procedures.
"[ \t]*(")
"Regexp whose first part matches F90 intrinsic procedures.")
"block" "cyclic" "extrinsic" "new" "onto" "pure" "with") 'words)
"Regexp for all HPF keywords, procedures and directives.")
-;; Highlighting patterns.
+(defconst f90-constants-re
+ (regexp-opt '( ;; F2003 iso_fortran_env constants.
+ "iso_fortran_env"
+ "input_unit" "output_unit" "error_unit"
+ "iostat_end" "iostat_eor"
+ "numeric_storage_size" "character_storage_size"
+ "file_storage_size"
+ ;; F2003 iso_c_binding constants.
+ "iso_c_binding"
+ "c_int" "c_short" "c_long" "c_long_long" "c_signed_char"
+ "c_size_t"
+ "c_int8_t" "c_int16_t" "c_int32_t" "c_int64_t"
+ "c_int_least8_t" "c_int_least16_t" "c_int_least32_t"
+ "c_int_least64_t"
+ "c_int_fast8_t" "c_int_fast16_t" "c_int_fast32_t"
+ "c_int_fast64_t"
+ "c_intmax_t" "c_intptr_t"
+ "c_float" "c_double" "c_long_double"
+ "c_float_complex" "c_double_complex" "c_long_double_complex"
+ "c_bool" "c_char"
+ "c_null_char" "c_alert" "c_backspace" "c_form_feed"
+ "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.
- '("\\<\\(\\(?:end[ \t]*\\)?type\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
- (1 font-lock-keyword-face) (3 font-lock-function-name-face))
+;;; '("\\<\\(\\(?: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))
;; Other functions and declarations.
- '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|\
+ '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|associate\\|\
subroutine\\)\\|use\\|call\\)\\>[ \t]*\\(\\sw+\\)?"
(1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
- "\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>")
+ ;; 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\\|\
+end[ \t]*interface\\)\\>"
+ ;; "abstract interface" is F2003. Must come after previous entry.
+ '("\\<\\(\\(?:abstract[ \t]*\\)?interface\\)\\>"
+ ;; [ \t]*\\(\\(\\sw+\\)[ \t]*[^(]\\)?"
+ ;; (2) messes up "interface operator ()", etc.
+ (1 font-lock-keyword-face))) ;(2 font-lock-function-name-face nil 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).
- '("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\
-logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\)\
+ ;; 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))
- ;; do, if, select, where, and forall constructs.
- '("\\<\\(end[ \t]*\\(do\\|if\\|select\\|forall\\|where\\)\\)\\>\
+ ;; 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.
+ ;; 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))
+ ;; enum (F2003; cf type in -1).
+ '("\\<\\(enum\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
+ (1 font-lock-keyword-face) (3 font-lock-function-name-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\\|\
-do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>"
+do\\([ \t]*while\\)?\\|select[ \t]*\\(?:case\\|type\\)\\|where\\|\
+forall\\)\\)\\>"
(2 font-lock-constant-face nil t) (3 font-lock-keyword-face))
;; Implicit declaration.
'("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\
-\\|logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*"
+\\|enumerator\\|procedure\\|\
+logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*"
(1 font-lock-keyword-face) (2 font-lock-type-face))
'("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/"
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
'("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>"
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
'("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1)
- '("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)"
+ ;; F2003 "class default".
+ '("\\<\\(class\\)[ \t]*default" . 1)
+ ;; F2003 "type is" in a "select type" block.
+ '("\\<\\(\\(type\\|class\\)[ \t]*is\\)[ \t]*(" (1 font-lock-keyword-face t))
+ '("\\<\\(do\\|go[ \t]*to\\)\\>[ \t]*\\([0-9]+\\)"
(1 font-lock-keyword-face) (2 font-lock-constant-face))
;; Line numbers (lines whose first character after number is letter).
'("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t))))
f90-operators-re
(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)))
"Highlights all F90 keywords and intrinsic procedures.")
(defvar f90-font-lock-keywords-4
(append f90-font-lock-keywords-3
- (list f90-hpf-keywords-re))
- "Highlights all F90 and HPF keywords.")
+ (list (cons f90-constants-re 'font-lock-constant-face)
+ f90-hpf-keywords-re))
+ "Highlights all F90 and HPF keywords and constants.")
(defvar f90-font-lock-keywords
f90-font-lock-keywords-2
"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
(concat "\\(block[ \t]*data\\|"
(regexp-opt '("do" "if" "interface" "function" "module" "program"
- "select" "subroutine" "type" "where" "forall"))
+ "select" "subroutine" "type" "where" "forall"
+ ;; F2003.
+ "enum" "associate"))
"\\)\\>")
"Regexp potentially indicating a \"block\" of F90 code.")
(regexp-opt '("program" "module" "subroutine" "function") 'paren)
"Regexp used to locate the start/end of a \"subprogram\".")
+;; "class is" is F2003.
(defconst f90-else-like-re
- "\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\)"
- "Regexp matching an ELSE IF, ELSEWHERE, CASE statement.")
+ "\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\|\
+\\(class\\|type\\)[ \t]*is[ \t]*(\\|class[ \t]*default\\)"
+ "Regexp matching an ELSE IF, ELSEWHERE, CASE, CLASS/TYPE IS statement.")
(defconst f90-end-if-re
(concat "end[ \t]*"
"Regexp matching the end of an IF, SELECT, WHERE, FORALL block.")
(defconst f90-end-type-re
- "end[ \t]*\\(type\\|interface\\|block[ \t]*data\\)\\>"
- "Regexp matching the end of a TYPE, INTERFACE, BLOCK DATA section.")
+ "end[ \t]*\\(type\\|enum\\|interface\\|block[ \t]*data\\)\\>"
+ "Regexp matching the end of a TYPE, ENUM, INTERFACE, BLOCK DATA section.")
+
+(defconst f90-end-associate-re
+ "end[ \t]*associate\\>"
+ "Regexp matching the end of an ASSOCIATE block.")
+;; This is for a TYPE block, not a variable of derived TYPE.
+;; Hence no need to add CLASS for F2003.
(defconst f90-type-def-re
+ ;; type word
+ ;; type :: word
+ ;; type, stuff :: word
+ ;; NOT "type ("
"\\<\\(type\\)\\>\\(?:[^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
"Regexp matching the definition of a derived type.")
+(defconst f90-typeis-re
+ "\\<\\(class\\|type\\)[ \t]*is[ \t]*("
+ "Regexp matching a CLASS/TYPE IS statement.")
+
(defconst f90-no-break-re
(regexp-opt '("**" "//" "=>" ">=" "<=" "==" "/=") 'paren)
"Regexp specifying where not to break lines when filling.
(concat "^[ \t0-9]*\\<end[ \t]*"
(regexp-opt '("do" "if" "forall" "function" "interface"
"module" "program" "select" "subroutine"
- "type" "where" ) t)
- "[ \t]*\\sw*")
+ "type" "where" "enum" "associate") t)
+ "\\>")
"Regexp matching the end of an F90 \"block\", from the line start.
Used in the F90 entry in `hs-special-modes-alist'.")
"^[ \t0-9]*" ; statement number
"\\(\\("
"\\(\\sw+[ \t]*:[ \t]*\\)?" ; structure label
- "\\(do\\|select[ \t]*case\\|"
+ "\\(do\\|select[ \t]*\\(case\\|type\\)\\|"
;; See comments in fortran-start-block-re for the problems of IF.
"if[ \t]*(\\(.*\\|"
".*\n\\([^if]*\\([^i].\\|.[^f]\\|.\\>\\)\\)\\)\\<then\\|"
;; Distinguish WHERE block from isolated WHERE.
"\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)\\)\\)"
"\\|"
- "program\\|interface\\|module\\|type\\|function\\|subroutine"
+ ;; Avoid F2003 "type is" in "select type",
+ ;; and also variables of derived type "type (foo)".
+ ;; "type, foo" must be a block (?).
+ "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\\|"
+ ;; "enum", but not "enumerator".
+ "function\\|subroutine\\|enum[^e]\\|associate"
"\\)"
"[ \t]*")
"Regexp matching the start of an F90 \"block\", from the line start.
\f
;; Imenu support.
+;; 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 l)
+ (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
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" )
- ("`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" )
- ("`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" )
- ("`pu" "public" )
- ("`r" "real" )
- ("`rc" "recursive" )
- ("`rt" "return" )
- ("`rw" "rewind" )
- ("`se" "select" )
- ("`sq" "sequence" )
- ("`su" "subroutine" )
- ("`ta" "target" )
- ("`tr" ".true." )
- ("`t" "type" )
- ("`wh" "where" )
- ("`wr" "write" ))))
+;; Not in defvar because user abbrevs may be restored before this file loads.
+(mapc
+ (lambda (e)
+ (condition-case nil
+ (define-abbrev f90-mode-abbrev-table (car e) (cdr e) nil :count 0
+ :system t)
+ (wrong-number-of-arguments ; Emacs 22
+ (define-abbrev f90-mode-abbrev-table (car e) (cdr e) nil 0 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" )))
\f
;;;###autoload
`f90-do-indent'
Extra indentation within do blocks (default 3).
`f90-if-indent'
- Extra indentation within if/select case/where/forall blocks (default 3).
+ Extra indentation within if/select/where/forall blocks (default 3).
`f90-type-indent'
- Extra indentation within type/interface/block-data blocks (default 3).
+ Extra indentation within type/enum/interface/block-data blocks (default 3).
`f90-program-indent'
Extra indentation within program/module/subroutine/function blocks
(default 2).
(list (match-string 3) (match-string 2))))
(defsubst f90-looking-at-select-case ()
- "Return (\"select\" NAME) if a select-case statement starts after point.
+ "Return (\"select\" NAME) if a select statement starts after point.
NAME is nil if the statement has no label."
(if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\
-\\(select\\)[ \t]*case[ \t]*(")
+\\(select\\)[ \t]*\\(case\\|type\\)[ \t]*(")
(list (match-string 3) (match-string 2))))
(defsubst f90-looking-at-if-then ()
(looking-at "then\\>")))
(list struct label))))))
+;; FIXME label?
+(defsubst f90-looking-at-associate ()
+ "Return (\"associate\") if an associate block starts after point."
+ (if (looking-at "\\<\\(associate\\)[ \t]*(")
+ (list (match-string 1))))
+
(defsubst f90-looking-at-where-or-forall ()
"Return (KIND NAME) if a where or forall block starts after point.
NAME is nil if the statement has no label."
(if (looking-at "\\(!\\|$\\)") (list struct label))))))
(defsubst f90-looking-at-type-like ()
- "Return (KIND NAME) if a type/interface/block-data block starts after point.
+ "Return (KIND NAME) if a type/enum/interface/block-data starts after point.
NAME is non-nil only for type."
(cond
- ((looking-at f90-type-def-re)
- (list (match-string 1) (match-string 2)))
- ((looking-at "\\(interface\\|block[ \t]*data\\)\\>")
+ ((save-excursion
+ (and (looking-at "\\<type[ \t]*")
+ (goto-char (match-end 0))
+ (not (looking-at "\\(is\\>\\|(\\)"))
+ (or (looking-at "\\(\\sw+\\)")
+ (re-search-forward "[ \t]*::[ \t]*\\(\\sw+\\)"
+ (line-end-position) t))))
+ (list "type" (match-string 1)))
+;;; ((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\\)\\>")
+ (list (match-string 1) nil))
+ ((looking-at "abstract[ \t]*\\(interface\\)\\>")
(list (match-string 1) nil))))
(defsubst f90-looking-at-program-block-start ()
(save-excursion
(not (or (looking-at "end")
(looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\
-\\|select[ \t]*case\\|case\\|where\\|forall\\)\\>")
- (looking-at "\\(program\\|module\\|interface\\|\
-block[ \t]*data\\)\\>")
+\\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\)\\>")
+ (looking-at "\\(program\\|module\\|\
+\\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\>")
(looking-at "\\(contains\\|\\sw+[ \t]*:\\)")
(looking-at f90-type-def-re)
(re-search-forward "\\(function\\|subroutine\\)"
((or (f90-looking-at-if-then)
(f90-looking-at-where-or-forall)
(f90-looking-at-select-case))
- (setq icol (+ icol f90-if-indent))))
+ (setq icol (+ icol f90-if-indent)))
+ ((f90-looking-at-associate)
+ (setq icol (+ icol f90-associate-indent))))
(end-of-line))
(while (re-search-forward
"\\(if\\|do\\|select\\|where\\|forall\\)" epnt t)
(f90-looking-at-where-or-forall)
(f90-looking-at-select-case))
(setq icol (+ icol f90-if-indent)))
+ ((f90-looking-at-associate)
+ (setq icol (+ icol f90-associate-indent)))
((looking-at f90-end-if-re)
(setq icol (- icol f90-if-indent)))
+ ((looking-at f90-end-associate-re)
+ (setq icol (- icol f90-associate-indent)))
((looking-at "end[ \t]*do\\>")
(setq icol (- icol f90-do-indent))))
(end-of-line))
(setq icol (+ icol f90-do-indent)))
((f90-looking-at-type-like)
(setq icol (+ icol f90-type-indent)))
+ ((f90-looking-at-associate)
+ (setq icol (+ icol f90-associate-indent)))
((or (f90-looking-at-program-block-start)
(looking-at "contains[ \t]*\\($\\|!\\)"))
(setq icol (+ icol f90-program-indent)))))
(setq icol (- icol f90-do-indent)))
((looking-at f90-end-type-re)
(setq icol (- icol f90-type-indent)))
+ ((looking-at f90-end-associate-re)
+ (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 ()
(f90-looking-at-do)
(f90-looking-at-select-case)
(f90-looking-at-type-like)
+ (f90-looking-at-associate)
(f90-looking-at-program-block-start)
(f90-looking-at-if-then)
(f90-looking-at-where-or-forall)))
(f90-looking-at-do)
(f90-looking-at-select-case)
(f90-looking-at-type-like)
+ (f90-looking-at-associate)
(f90-looking-at-program-block-start)
(f90-looking-at-if-then)
(f90-looking-at-where-or-forall)))
(f90-looking-at-do)
(f90-looking-at-select-case)
(f90-looking-at-type-like)
+ (f90-looking-at-associate)
(f90-looking-at-program-block-start)
(f90-looking-at-if-then)
(f90-looking-at-where-or-forall))
(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))
f90-if-indent)
((setq struct (f90-looking-at-type-like))
f90-type-indent)
+ ((setq struct (f90-looking-at-associate))
+ f90-associate-indent)
((or (setq struct (f90-looking-at-program-block-start))
(looking-at "contains[ \t]*\\($\\|!\\)"))
f90-program-indent)))
f90-if-indent)
((setq struct (f90-looking-at-type-like))
f90-type-indent)
+ ((setq struct (f90-looking-at-associate))
+ f90-associate-indent)
((setq struct (f90-looking-at-program-block-start))
f90-program-indent)))
(setq ind-curr ind-lev)
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)
((looking-at f90-end-type-re) f90-type-indent)
+ ((looking-at f90-end-associate-re)
+ f90-associate-indent)
((f90-looking-at-program-block-end)
f90-program-indent)))
(if ind-b (setq ind-lev (- ind-lev ind-b)))
(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")))))
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)
(f90-looking-at-where-or-forall)
(f90-looking-at-select-case)
(f90-looking-at-type-like)
+ (f90-looking-at-associate)
(f90-looking-at-program-block-start)
;; Interpret a single END without a block
;; start to be the END of a program block
(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))))))
(provide 'f90)
-;;; arch-tag: fceac97c-c147-44bd-aec0-172d4b560ef8
+;; arch-tag: fceac97c-c147-44bd-aec0-172d4b560ef8
;;; f90.el ends here
HCoop / bpt / emacs.git / blobdiff